Excelで毎月のデータ集計業務を効率化！~ChatGPTで0から始めるVBAコード~

ChatGPTを使ってVBAコードを作ってもらいました！

VBAをほぼ触ったことのない私が、毎月発生するExcel集計業務をVBAで効率化しました。
どれだけ初心者かといいますと、ChatGPTにまず質問したことは「Excelでマクロを入力するには」 でした。

そのレベルからChatGPTは丁寧に説明してくれました。
まずは、Excelの開発ツール設定から入りました笑

質問を繰り返して最終的にできたのは…

プログラムを開く(折りたたみしています。)

Sub ProcessSheets()
    Dim ws As Worksheet
    Dim wsSeikyu As Worksheet
    Dim wsSeikyuKingaku As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim keyword As String
    
    ' シートを設定
    Set ws = ThisWorkbook.Sheets("作業シート")
    Set wsSeikyu = ThisWorkbook.Sheets("請求先")
    Set wsSeikyuKingaku = ThisWorkbook.Sheets("請求金額")
    
    ' 検索キーワード
    keyword = "修正"
    
    ' I列の最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    
    ' 最後の行から逆方向にループして、キーワードを含む行を削除
    For i = lastRow To 1 Step -1
        If InStr(ws.Cells(i, "I").Value, keyword) > 0 Then
            ws.Rows(i).Delete
        End If
    Next i

    ' 再度最終行を取得（行削除後の再計算）
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' A列を「請求先」シートのA列にコピー
    ws.Range("A1:A" & lastRow).Copy Destination:=wsSeikyu.Range("A1")
    
    ' A列を「請求金額」シートのA列にコピー
    ws.Range("A1:A" & lastRow).Copy Destination:=wsSeikyuKingaku.Range("A1")
    
    ' Q列を「請求先」シートのB列にコピー
    ws.Range("Q1:Q" & lastRow).Copy Destination:=wsSeikyu.Range("B1")
    
    ' S列を「請求金額」シートのB列にコピー
    ws.Range("S1:S" & lastRow).Copy Destination:=wsSeikyuKingaku.Range("B1")
    
    ' 「請求先」シートのB列を";"で区切る
    Call SplitColumnByDelimiter(wsSeikyu, "B", ";")
    
    ' 「請求金額」シートのB列を";"で区切る
    Call SplitColumnByDelimiter(wsSeikyuKingaku, "B", ";")
    
    
    ' 後続処理を呼び出し
    
    Call CopyB1ToNonEmptyColumns
    Call CopyB1ToNonEmptyColumns2
    Call InsertAColumnNextNext
    Call InsertAColumnNextNext2
    Call CombineColumns
    Call CombineColumns2
    Call CopyColumnsToPivotData
    
End Sub

Sub SplitColumnByDelimiter(ws As Worksheet, colLetter As String, delimiter As String)
    Dim lastRow As Long
    Dim i As Long
    Dim cellValue As String
    Dim splitValues As Variant
    Dim j As Long
    Dim colNum As Long

    ' 最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, colLetter).End(xlUp).Row
    colNum = Columns(colLetter).Column

    ' 各行のセルの値を分割して新しい列に設定
    For i = 1 To lastRow
        cellValue = ws.Cells(i, colNum).Value
        If cellValue <> "" Then
            splitValues = Split(cellValue, delimiter)
            For j = LBound(splitValues) To UBound(splitValues)
                ws.Cells(i, colNum + j).Value = splitValues(j)
            Next j
        End If
    Next i
End Sub

Sub CopyB1ToNonEmptyColumns()
    Dim ws As Worksheet
    Dim col As Long
    Dim lastRow As Long
    Dim cell As Range
    
    ' シートを設定
    Set ws = ThisWorkbook.Sheets("請求先")
    
    ' B1の値を取得
    Dim b1Value As String
    b1Value = ws.Range("B1").Value
    
    ' C列からT列までループ
    For col = 3 To 20 ' C列は3、T列は20
        ' 最終行を取得
        lastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
        
        ' 列内のセルをループしてNULL（空白）ではないセルを確認
        For Each cell In ws.Range(ws.Cells(1, col), ws.Cells(lastRow, col))
            If cell.Value <> "" Then
                ' 1行目にB1の値をコピー＆ペースト
                ws.Cells(1, col).Value = b1Value
                ' 列内にNULL（空白）でないデータが1つでもあれば次の列に進む
                Exit For
            End If
        Next cell
    Next col
End Sub

Sub CopyB1ToNonEmptyColumns2()
    Dim ws As Worksheet
    Dim col As Long
    Dim lastRow As Long
    Dim cell As Range
    
    ' シートを設定
    Set ws = ThisWorkbook.Sheets("請求金額")
    
    ' B1の値を取得
    Dim b1Value As String
    b1Value = ws.Range("B1").Value
    
    ' C列からT列までループ
    For col = 3 To 20 ' C列は3、T列は20
        ' 最終行を取得
        lastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
        
        ' 列内のセルをループしてNULL（空白）ではないセルを確認
        For Each cell In ws.Range(ws.Cells(1, col), ws.Cells(lastRow, col))
            If cell.Value <> "" Then
                ' 1行目にB1の値をコピー＆ペースト
                ws.Cells(1, col).Value = b1Value
                ' 列内にNULL（空白）でないデータが1つでもあれば次の列に進む
                Exit For
            End If
        Next cell
    Next col
End Sub

Sub InsertAColumnNextNext()
    Dim ws As Worksheet
    Dim currentCol As Long
    Dim lastCol As Long
    
    ' シートを設定
    Set ws = ThisWorkbook.Sheets("請求先")
    
    ' 最初の挿入位置はB列の次の列（C列）
    currentCol = 3 ' C列
    
    ' 最終列を取得
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ' 挿入処理を繰り返す
    Do While currentCol <= lastCol + 1
        ' A列のデータをコピー
        ws.Columns("A").Copy
        
        ' 現在の位置にA列のコピーを挿入
        ws.Columns(currentCol).Insert Shift:=xlToRight
        ws.Columns(currentCol).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        
        ' 挿入位置を次の次の列に設定
        currentCol = currentCol + 2
        
        ' 挿入後の最終列を再取得
        lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    Loop
End Sub

Sub InsertAColumnNextNext2()
    Dim ws As Worksheet
    Dim currentCol As Long
    Dim lastCol As Long
    
    ' シートを設定
    Set ws = ThisWorkbook.Sheets("請求金額")
    
    ' 最初の挿入位置はB列の次の列（C列）
    currentCol = 3 ' C列
    
    ' 最終列を取得
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ' 挿入処理を繰り返す
    Do While currentCol <= lastCol + 1
        ' A列のデータをコピー
        ws.Columns("A").Copy
        
        ' 現在の位置にA列のコピーを挿入
        ws.Columns(currentCol).Insert Shift:=xlToRight
        ws.Columns(currentCol).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        
        ' 挿入位置を次の次の列に設定
        currentCol = currentCol + 2
        
        ' 挿入後の最終列を再取得
        lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    Loop
End Sub

Sub CombineColumns()
    Dim ws As Worksheet
    Dim lastRowAB As Long
    Dim lastRow As Long
    Dim startRow As Long
    Dim i As Long
    Dim currentCol As Long
    
    ' シートを設定
    Set ws = ThisWorkbook.Sheets("請求先")
    
    ' AB列の最後の行を取得
    lastRowAB = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' データをまとめる開始行を設定（AB列の最後の行の次の行）
    startRow = lastRowAB + 1
    
    ' 列の初期設定（CD列から開始）
    currentCol = 3 ' C列
    
    ' データがなくなるまで2列ずつ処理
    Do While ws.Cells(1, currentCol).Value <> "" Or ws.Cells(2, currentCol).Value <> ""
        ' 処理する列の最終行を取得
        lastRow = ws.Cells(ws.Rows.Count, currentCol).End(xlUp).Row
        
        ' 2列分のデータをAB列の次に追加
        For i = 1 To lastRow
            ws.Cells(startRow + i - 1, 1).Value = ws.Cells(i, currentCol).Value ' 現在の列をA列に
            ws.Cells(startRow + i - 1, 2).Value = ws.Cells(i, currentCol + 1).Value ' 次の列をB列に
        Next i
        
        ' データを追加した後の最後の行を再計算
        startRow = startRow + lastRow
        
        ' 次の2列に移動
        currentCol = currentCol + 2
    Loop
    
    ' C列以降のデータを削除
    ws.Range(ws.Cells(1, 3), ws.Cells(ws.Rows.Count, ws.Columns.Count)).ClearContents
End Sub

Sub CombineColumns2()
    Dim ws As Worksheet
    Dim lastRowAB As Long
    Dim lastRow As Long
    Dim startRow As Long
    Dim i As Long
    Dim currentCol As Long
    
    ' シートを設定
    Set ws = ThisWorkbook.Sheets("請求金額")
    
    ' AB列の最後の行を取得
    lastRowAB = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' データをまとめる開始行を設定（AB列の最後の行の次の行）
    startRow = lastRowAB + 1
    
    ' 列の初期設定（CD列から開始）
    currentCol = 3 ' C列
    
    ' データがなくなるまで2列ずつ処理
    Do While ws.Cells(1, currentCol).Value <> "" Or ws.Cells(2, currentCol).Value <> ""
        ' 処理する列の最終行を取得
        lastRow = ws.Cells(ws.Rows.Count, currentCol).End(xlUp).Row
        
        ' 2列分のデータをAB列の次に追加
        For i = 1 To lastRow
            ws.Cells(startRow + i - 1, 1).Value = ws.Cells(i, currentCol).Value ' 現在の列をA列に
            ws.Cells(startRow + i - 1, 2).Value = ws.Cells(i, currentCol + 1).Value ' 次の列をB列に
        Next i
        
        ' データを追加した後の最後の行を再計算
        startRow = startRow + lastRow
        
        ' 次の2列に移動
        currentCol = currentCol + 2
    Loop
    
    ' C列以降のデータを削除
    ws.Range(ws.Cells(1, 3), ws.Cells(ws.Rows.Count, ws.Columns.Count)).ClearContents
End Sub

Sub CopyColumnsToPivotData()
    Dim wsSeikyu As Worksheet
    Dim wsSeikyuKingaku As Worksheet
    Dim wsPivotData As Worksheet
    Dim lastRowSeikyu As Long
    Dim lastRowSeikyuKingaku As Long
    
    ' シートを設定
    Set wsSeikyu = ThisWorkbook.Sheets("請求先")
    Set wsSeikyuKingaku = ThisWorkbook.Sheets("請求金額")
    Set wsPivotData = ThisWorkbook.Sheets("ピポット用データ")
    
    ' 請求先シートのAB列の最終行を取得
    lastRowSeikyu = wsSeikyu.Cells(wsSeikyu.Rows.Count, "A").End(xlUp).Row
    
    ' 請求先シートのAB列をピポット用データシートのAB列にコピー
    wsSeikyu.Range("A1:B" & lastRowSeikyu).Copy Destination:=wsPivotData.Range("A1")
    
    ' 請求金額シートのB列の最終行を取得
    lastRowSeikyuKingaku = wsSeikyuKingaku.Cells(wsSeikyuKingaku.Rows.Count, "B").End(xlUp).Row
    
    ' 請求金額シートのC列をピポット用データシートのC列にコピー
    wsSeikyuKingaku.Range("B1:B" & lastRowSeikyuKingaku).Copy Destination:=wsPivotData.Range("C1")
End Sub

もう少しシンプルなコーディングができたかもしれませんが、 0から作ったわりにうまくできたと思います。(自画自賛)

今回作成したもの

今回作成したツールは、他システムから出した請求データを使って、請求先と金額を算出する というツールです。


「Excel関数でよくない？」

そうです、請求先カラムと請求金額カラムがあり、
1:1の関係であればsumif関数とかVlook関数とかでいいんですが、
今回は1カラムに複数請求先/請求金額が入っておりました。

決裁単位で請求が発生するため、複数請求先、金額が発生するシステムでした。
元となるシステムの開発費や改修による影響が高いため、
カラム数を変えず1カラムで複数データを扱うことはたまに見かけます。
Excel関数で集計できたらやり方教えてください

従来では区切り位置の調整を行い、カラムを整えて集約しておりました。
この作業に時間がかかったので、マクロ実行するとこのような集計ができるようになりました。

※説明のため、ダミーデータかつ、必要ないカラムは削除しています。

削減効果は30分～1時間/月の作業を、、、
20秒/月に削減しました！！

使用したツール

使用したツールは下記2つだけです。

・ChatGPT
・Excel

作成手順

前段触れたように、
①ChatGPTに要件を説明
②コーディングしてもらう
③ExcelのVBAエディターに貼り実行する
④エラー等調整する
上記のように部分部分で機能を開発して、最後に繋げました。

具体的に下記のような依頼をしました。
※細かい要件、エラー修正などは含みません

下記要件を実現するExcelのVBAコードをおしえてください。
"作業シート"のI列に"修正"が含まれる列を削除する。
"作業シート"A列を"請求先"のA列にコピーする。
"作業シート"A列を"請求金額"のA列にコピーする。
"作業シート"Q列を"請求先"のB列にコピーする。
"作業シート"S列を"請求金額"のB列にコピーする。
"請求先"のB列にExcel操作でデータ>区切り位置>コンマやタブなどの区切り文字によってフィールドごとに区切られたデータ>その他";"を使って;でカラムを区切る。
"請求金額"のB列にExcel操作でデータ>区切り位置>コンマやタブなどの区切り文字によってフィールドごとに区切られたデータ>その他";"を使って;でカラムを区切る。

下記要件を実現するExcelのVBAコードをおしえてください。
"請求書"のC列にNULLじゃないデータがあれば1行目にB1の値をコピー＆ペーストする。
以降D列～T列まで同様の処理を行う

下記要件を実現するExcelのVBAコードをおしえてください。
"請求先"のA列の次の列がある場合、A列をコピーし次の次の列にコピーした列の挿入をする。
挿入した列に次の列がある場合、A列をコピーし次の次の列にコピーした列の挿入をする。
以後、次に列があるまで連続する。

下記要件を実現するExcelのVBAコードをおしえてください。
"請求先"をAB列の2行にまとめたいです。
例：
AB列の最後の列の次の列からCD列の1行目から最後の行までをもってきて、
また、AB列の最後の列の次の列からEF列の1行目から最後の行までをもってくる。
以後、次に列がなくなるまで連続する。

下記要件を実現するExcelのVBAコードをおしえてください。
"請求先"のAB列を"ピポット用データ"のAB列にコピーしてください。
"請求金額"のB列を"ピポット用データ"のC列にコピーしてください。

ExcelのVBAコードにおいて下記を1度に連続で実行する方法をおしえてください。
Sub ProcessSheets()
Sub SplitColumnByDelimiter(ws As Worksheet, colLetter As String, delimiter As String)
Sub CopyB1ToNonEmptyColumns()
Sub CopyB1ToNonEmptyColumns2()
Sub InsertAColumnNextNext()
Sub InsertAColumnNextNext2()
Sub CombineColumns()
Sub CombineColumns2()
Sub CopyColumnsToPivotData()

修正・調整については下記のように対応いたしました。

エラーが発生した場合
⇒エラー文章をそのまま送り、
　ChatGPTに修正依頼をしました。

思うような動作がされないとき
⇒現在どういう動作をしているか、自分の想定とのギャップをChatGPTに伝え、
　修正依頼をしました。
⇒要件をもう少し具体的・詳細に記載し再度依頼をかけました。

うまく伝わらない
⇒私の場合は「;」でカラムを区切る部分がうまく伝わらなかったです。
　当初は、『「;」で区切り、カラムを分ける』や、『「A;B」を;で区切り「A」と「B」でカラム分けする』など要望したが伝わりませんでした。

そのため、実際のExcel操作（このボタンを押す）などの伝え方を行ったら、良いコードが出てきました。
伝え方の工夫をしてみてください。

反省/まとめ

VBAを最初から学ぶのであれば、数週間～数か月時間がかかりますが、AIを使うと0から作れることが分かりました。
その時間で他の業務を行ったり、業務改善に時間を当てられました。
また、コードを見ること、要件をまとめることで学習にもいいと感じました。
英語の勉強で文法を飛ばして英会話しちゃう感覚？

反省点としては
「なぜChatGPTをもっと早く使わなかったのだ」
これにつきます。
正確な数字報告などが求められる場面など、使わない方がいいところはありますが、
非常に頼りになるツールだと感じました。