マクロ(ExcelVBA)を使ってみた！

VBA(マクロ)について

• VBはこれまで使ったことがあったが、マクロ作成はしてこなかった。
• 少し触ってみて便利だと感じたものについて備忘録として残そうと思う。

①選択範囲を一括でクリアする。

【実行前】

• 数量のセルを一括でクリアする。

'内容を一括クリアする
Sub ClearContents()

    '一括クリアしたい数量のセルを選択
    Range("C4:C6").Select
    
    '選択範囲をクリア
    Selection.ClearContents
    
End Sub

【実行後】

• 数量のセルを一括でクリアされており、合計の値には何もはいっていない。(元々は計算で算出されていた。)

②複数行を一括で削除する。

【実行前】

• 削除したい行の削除列に"e"(eraseの頭文字、今回そうしただけ。別になんでも良い)を入力。

'該当行を削除する
Sub DeleteRows()

    '最終行格納用変数
    Dim maxRow As Long
    
    '最終行を取得する(Sheet自体の一番下のセルから上に上がり最初にぶつかったセル)
    maxRow = Cells(Rows.Count, 1).End(xlUp).Row

    '下の行から順番に上に見ていく(入力項目のスタートは3行目から)
    Dim i As Long
    For i = maxRow To 3 Step -1
    
        '削除列に「e」と記載されているとき
        If Range("E" & i).Value = "e" Then
            
            '該当行を削除
            Rows(i).Delete
    
        End If
    
    Next i
    
End Sub

【実行後】

• 削除対象であった、ボールペン、消しゴム、定規の列が削除されている。

③複数シートの内容を一つのシートにまとめる。

【実行前】
★まとめシート

• 202105から202107のシートの内容をまとめのシートに一緒に記載する。

(1)202105シート

(2)202106シート

(3)202107シート

'それぞれのシートの内容をまとめシートにコピーする
Sub MergeDate()

    'カウンタ変数
    Dim i As Long
    
    'コピー元の最終行
    Dim maxRow1 As Long
    
    'コピー先の最終行
    Dim maxRow2 As Long
    
    '全てのシート分繰り返す
    For i = 1 To Sheets.Count
    
        'もしシートの名前が「まとめ」以外は実行
        If Sheets(i).Name <> "まとめ" Then
        
            'コピー元の最終行を取得
            maxRow1 = Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
            
            'コピー先の最終行を取得
            maxRow2 = Sheets("まとめ").Cells(Rows.Count, 1).End(xlUp).Row
            
            'それぞれのシートの一行目から最終行までのデータをまとめシート(最終行の次の行から)にコピーする
            Sheets(i).Range("A4:C" & maxRow1).Copy Destination:=Sheets("まとめ").Range("A" & maxRow2 + 1)
            
        End If
    
    Next i
       
End Sub

【実行後】

• 5月から7月までのそれぞれのシートに記載された内容が一つのシートにマージされている。

④表の内容をデコレーションする

【実行前】

• 表のヘッダー以外が真っ白で味気ないので、2行単位に色を塗る。

'表を1行とばしで塗りつぶす
Sub DecorationTable()

    '最終行を取得
    Dim maxRow As Long
    maxRow = Cells(Rows.Count, 1).End(xlUp).Row

    '行を1つずつ数える
    Dim i As Long
    For i = 4 To maxRow
    
        '奇数行のとき(ヘッダーの下から交互に色をつけていく。最初は5行目)
        If Range("A" & i).Row Mod 2 = 1 Then
        
            '5行目から最終行目までの奇数行に色を付ける
            Range("A" & i).Resize(1, 3).Interior.Color = RGB(255, 242, 204)
            
        End If
    
    Next i
    
End Sub

【実行後】

⑤複数ワークブックの内容を一つのシートにまとめる。

【実行前】

★まとめワークブック(CostAll.xlsx)

(1)統合元ワークブック(Cost202105.xlsx)

(2)統合元ワークブック(Cost202106.xlsx)

(3)統合元ワークブック(Cost202107.xlsx)

'開いているワークブックから順番にデータをコピーする
Sub MergeBookData()

    '全ての開いているすべてのワークブックで繰り返し処理を行う
    Dim workbook As Variant
    For Each workbook In Workbooks
    
        'このまとめブック(CostAll.xlsx)は除外する
        If workbook.Name <> ThisWorkbook.Name Then
            
            'コピー元の最終行格納用変数
            Dim maxRow As Long
            
            'コピー先の最終行格納用変数
            Dim maxRow2 As Long
            
            'コピー元の最終行を取得
            maxRow = workbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
            
            'コピー先の最終行格納用変数
            maxRow2 = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
            
            'コピー元の内容をコピー先のセルに貼り付ける
            workbook.Sheets(1).Range("A4:C" & maxRow).Copy ThisWorkbook.Sheets(1).Range("A" & maxRow2 + 1)
    
        End If
    
    Next workbook

    '統合データを並べ替える
    Range("A3").CurrentRegion.Offset(1, 0).Sort Key1:=Range("A4"), Order1:=xlAscending

End Sub

【実行後】

感想

• Excelは使用する機会が多いので、マクロも必要に応じて少しずつ覚えておこうと感じた。