|
|
|
2017.08.17
カテゴリ：カテゴリ未分類
Sub main() '変数宣言 Dim activecell_row As Integer Dim activecell_column As Integer Dim loop_count As Integer loop_count = 1 Dim i As Integer Dim row_number As Integer row_number = 5 Dim loop_cnt As Integer loop_cnt = 0 Dim sheetname As String sheetname = "new sheet" 'シート追加 Worksheets.Add.Name = sheetname '必要な文言を追加 Worksheets("new sheet").Range("B1") = "行" Worksheets("new sheet").Range("C1") = "列" Worksheets("new sheet").Range("D1") = "フォルダ(行)" Worksheets("new sheet").Range("E1") = "フォルダ(列)" Worksheets("new sheet").Range("F1") = "フォルダ" Worksheets("new sheet").Range("G1") = "グループ（行）" Worksheets("new sheet").Range("H1") = "グループ（列）" Worksheets("new sheet").Range("I1") = "グループ" Worksheets("new sheet").Range("J1") = "付与内容（行）" Worksheets("new sheet").Range("K1") = "付与内容（列）" Worksheets("new sheet").Range("L1") = "付与内容" 'セルをアクティブ化（本来はBE9） Worksheets("FAD").Activate Range("C3").Activate '繰り返し Do Until ActiveCell.Value = "endend" '空白の場合→右へ1つ移動 If ActiveCell.Value = "" Then ActiveCell.Offset(0, 1).Select 'end→下へ一つ移動＋左へ列数分移動 ElseIf ActiveCell.Value = "end" Then ActiveCell.Offset(1, "-" & row_number).Select Else activecell_row = ActiveCell.row activecell_column = ActiveCell.column loop_count = loop_count + 1 Worksheets(sheetname).Range("B" & loop_count) = activecell_row Worksheets(sheetname).Range("C" & loop_count) = activecell_column ActiveCell.Offset(0, 1).Select loop_cnt = loop_cnt + 1 End If Loop '新しいシートを編集 Dim copy As Integer Dim copy2 As Integer Dim copy3 As String Dim copy4 As String For i = 2 To loop_cnt + 1 Worksheets(sheetname).Activate 'コピーと定数 copy = Range("b" & i) Range("d" & i).Value = copy Range("j" & i).Value = copy Range("e" & i).Value = 2 Range("g" & i).Value = 2 copy2 = Range("c" & i) Range("h" & i).Value = copy2 Range("k" & i).Value = copy2 '他シートからコピー copy3 = Worksheets("FAD").Cells(copy, 2) Worksheets("new sheet").Range("f" & i) = copy3 copy3 = Worksheets("FAD").Cells(2, copy2) Worksheets("new sheet").Range("i" & i) = copy3 copy3 = Worksheets("FAD").Cells(copy, copy2) Worksheets("new sheet").Range("l" & i) = copy3 Next MsgBox "完了" End Sub お気に入りの記事を「いいね！」で応援しよう
最終更新日
2017.08.17 13:53:57
コメント(0) | コメントを書く |
