手間な反復作業をVBAで自動化＆同じ命令を3つのAIで比較してみた

こんにちは。
小売業で働いている会社員ふひーです。

私の業務の7割は、Excelを使って行う作業が多く、
毎日Excelとの闘いで奮闘中！

どうしたら少しでもこの作業が楽になる…？
ということで、最近は 「VBA」 にハマっています。

つきまして、今回はVBAを使用して業務改善をしたことと、
同じ命令を3つのAIに依頼した時の反応を比較してみた内容です。

作業の背景

私が担当している業務は、人事総務のお仕事です。
その仕事の一つとして、
「正しい人件費を算出するために、正確な人員情報をまとめる」作業を実施しています。

この作業は高度な作業ではありませんが、

• 毎回手作業で情報を転記している
• 手動でカウントしているので、カウントミスが発生
• コピーせずに手動入力している項目は、誤入力可能性 ↑
• クリック数は、最低130回以上

手間と時間がかかる＋間違ってはいけないこの反復作業を 「VBA」を使って自動化をすることにしました。

私はVBA専門家ではないため、コードの作成は、AIの力を借りることに！
しかし、数多くのAIの中から、どれを選択しようか．．．？

ということで、
同じ内容をChatGPT・Copilot・Geminiにそれぞれ依頼し、
どのAIの回答が一番良いか比較してみました。　　※全て、無料版使用（課金なし）

完成物（Gemini版）

1回のクリックで情報の転記完了！！

使用するExcelファイル

【人員報告書Format】
【店別まとめFormat】

• 人員報告書　→ 店舗から受けた人員情報・131店舗のシートがある
• 店別まとめ　→ 上記を一覧にまとめたもの
  ※人員情報は、社外秘につき今回は簡易版を使用しています。

AIに共通で送信した内容

　　　※ 人員情報は、社外秘につき、AIには文章でExcel内構成を説明しました ※

　

【依頼内容】

• 「人員報告書」のシート名は、店舗名
• 同じ店舗名を探して、「人員報告書」→「店別まとめ」に情報を転記
  ➀按分時間の合計を転記
  ②従業員の区分に [黄色]で塗っているセルを数えて入力
• 結合されたセルの情報も反映できるか

各AI別比較

	ChatGPT	Copilot	Gemini
初回命令処理時間	2秒	30秒	2秒
初回実行エラー	発生	未発生	発生
入力ミスの修正	なし	なし	あり
元ファイルの閲覧	ファイルが開いてない場合、選択するように誘導	ファイルが開いてないと、エラーが出て実行できない	同じフォルダ内にあれば、ファイルを自動で開閉
修正後のコード名	新しい名前で作成してくれる	同じ名前で上書きされる	新しい名前で作成してくれる

１．初回命令処理時間
依頼をして、回答をもらうまでかかった時間です。
ChatGPTとGeminiは回答が早かったですが、Copilotは少し時間がかかりました。

２．初回実行エラー
それぞれのAIからもらった最初のコードでマクロを実行すると、
ChatGPTとGeminiはエラーが出ました。
その後、話し合いながらChatGPT＋1回の修正・Geminiは＋2回の修正を重かけました。（コードを実行するまで）

３．入力ミスの修正
セル名を説明する時に、一部入力を間違えておりました。
　例）BBBCセルと書くべきところ、BABBセルと間違って記載
ChatGPTとCopilotは、そのまま間違った情報で処理し、算出すべき正しい数値より＋１の結果が出てしまいました。
しかし、Geminiは他の命令文との相互関係を確認し、自動で記入間違い部分を修正してくれました。

４．元ファイルの閲覧
AIが組んでくれたVBAコードの中に、
情報を持ってくる元のExcelファイル（人員報告書）が事前に開いているべきかを、特に指示しませんでしたが、スタイルが異なりました。

• ChatGPT：ファイルが開いてない場合、選択するように誘導してくれました。
• Copilot：ファイルが開いてないと、実行自体がエラーになりました。
• Gemini：ファイルを開いてなくても、同じフォルダに入っていたら、自動で開いて、処理後に閉じてくれました。

５．修正後のコード名
修正を重ねた時に、新しく作ったVBAコードの「Subの名称」が変わるかです。
ChatGPTとGeminiは、修正したら毎回新しい名前に変わりますが、
Copilotは、そのまま上書きされました。

VBAコード

■ ChatGPT

ChatGPTのVBAコードはこちら

Option Explicit

' メイン処理（BBBC = BB+BC（結合） を考慮した改良版）
Sub 人員情報_集計_改良版_BBBC対応()

    Dim wbSum As Workbook
    Dim wbRep As Workbook
    Dim wsSum As Worksheet
    Dim wsRep As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim storeName As String

    '---- ブック取得（開かれていなければユーザーに選ばせる） ----
    Set wbSum = GetWorkbookOrOpen("店別まとめ")
    If wbSum Is Nothing Then
        MsgBox "「店別まとめ」ブックが開けませんでした。処理を中止します。", vbExclamation
        Exit Sub
    End If
    
    Set wbRep = GetWorkbookOrOpen("人員報告書")
    If wbRep Is Nothing Then
        MsgBox "「人員報告書」ブックが開けませんでした。処理を中止します。", vbExclamation
        Exit Sub
    End If
    
    ' まとめシート（1枚目を想定）
    Set wsSum = wbSum.Sheets(1)
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' B列の最終行（店舗名）
    lastRow = wsSum.Cells(wsSum.Rows.Count, "B").End(xlUp).Row
    
    For i = 2 To lastRow '見出しが1行目と想定
        storeName = Trim(wsSum.Cells(i, "B").Value)
        If storeName <> "" Then
            On Error Resume Next
            Set wsRep = wbRep.Sheets(storeName)
            On Error GoTo 0
            
            If Not wsRep Is Nothing Then
                ' BI24 -> G列 (按分時間：日給月給)
                On Error Resume Next
                wsSum.Cells(i, "G").Value = wsRep.Range("BI24").Value
                If Err.Number <> 0 Then
                    wsSum.Cells(i, "G").Value = ""
                    Err.Clear
                End If
                On Error GoTo 0
                
                ' BI25 -> H列 (按分時間：時間給)
                On Error Resume Next
                wsSum.Cells(i, "H").Value = wsRep.Range("BI25").Value
                If Err.Number <> 0 Then
                    wsSum.Cells(i, "H").Value = ""
                    Err.Clear
                End If
                On Error GoTo 0
                
                ' ⑥ 日給月給 (AX:AY 7～21) : 値が "日給月給" かつ 黄色 のセルだけカウント -> E列
                wsSum.Cells(i, "E").Value = CountColoredCellsWithText(wsRep, "AX", 7, 21, "日給月給", vbYellow)
                
                ' ⑦ 時間給 (AZ:BA 7～21) と ARB (BB:BC 7～21) の黄色セル合計 -> F列
                Dim cntJikyu As Long, cntARB As Long
                cntJikyu = CountColoredCellsWithText(wsRep, "AZ", 7, 21, "時間給", vbYellow)
                ' ここを BB（=BBBC の左上セル）に変更しました
                cntARB = CountColoredCellsWithText(wsRep, "BB", 7, 21, "ARB", vbYellow)
                wsSum.Cells(i, "F").Value = cntJikyu + cntARB
                
                ' 全体人数（D列）の算出ルールが未指定のため処理無し（必要なら追記）
                
            Else
                ' 該当シート無し -> スキップ
            End If
            
            Set wsRep = Nothing
        End If
    Next i
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    MsgBox "集計が完了しました。", vbInformation

End Sub

' 指定のブック名（拡張子なしでも）で開かれているWorkbookを返す。
' 無ければファイル選択ダイアログで開く。ユーザーがキャンセルした場合は Nothing を返す。
Function GetWorkbookOrOpen(baseName As String) As Workbook
    Dim wb As Workbook
    Dim tryNames As Variant
    Dim nm As Variant
    Dim fPath As Variant
    
    tryNames = Array(baseName, baseName & ".xlsx", baseName & ".xlsm", baseName & ".xls")
    
    For Each nm In tryNames
        On Error Resume Next
        Set wb = Workbooks(nm)
        On Error GoTo 0
        If Not wb Is Nothing Then
            Set GetWorkbookOrOpen = wb
            Exit Function
        End If
    Next nm
    
    ' 開かれていなければファイル選択で開く（ユーザーに選択させる）
    fPath = Application.GetOpenFilename("Excelファイル (*.xls*), *.xls*," & _
                                        "すべてのファイル (*.*), *.*", , _
                                        "「" & baseName & "」ブックを選択してください")
    If VarType(fPath) = vbBoolean Then
        ' キャンセル（False）
        Set GetWorkbookOrOpen = Nothing
        Exit Function
    End If
    
    On Error Resume Next
    Set wb = Workbooks.Open(CStr(fPath))
    On Error GoTo 0
    
    If wb Is Nothing Then
        Set GetWorkbookOrOpen = Nothing
    Else
        Set GetWorkbookOrOpen = wb
    End If
End Function

' 指定ワークシート ws の、指定列（例 "AX"）の startRow～endRow を見て
' セルの値が targetText と一致、かつ Interior.Color が colorCode と一致するセル数を返す
Function CountColoredCellsWithText(ws As Worksheet, colLetter As String, startRow As Long, endRow As Long, targetText As String, colorCode As Long) As Long
    Dim r As Long
    Dim cnt As Long
    Dim cell As Range
    cnt = 0
    For r = startRow To endRow
        On Error Resume Next
        Set cell = ws.Range(colLetter & r)
        On Error GoTo 0
        If Not cell Is Nothing Then
            If Trim(CStr(cell.Value)) = targetText Then
                If cell.Interior.Color = colorCode Then
                    cnt = cnt + 1
                End If
            End If
        End If
        Set cell = Nothing
    Next r
    CountColoredCellsWithText = cnt
End Function

■ Copilot

CopilotのVBAコードはこちら

Option Explicit

' ========= ユーザー設定（必要に応じて変更） =========
Private Const SUMMARY_BOOK_NAME_KEY As String = "店別まとめ"   ' ブック名に含まれるキーワード
Private Const REPORT_BOOK_NAME_KEY  As String = "人員報告書"   ' ブック名に含まれるキーワード
Private Const SUMMARY_SHEET_NAME    As String = ""            ' 固定する場合はシート名を指定。空なら先頭シート

' 対象行範囲（AX:AY / AZ:BA / BB:BC） ※ヘッダーが7行なら 8 に変更で回避
Private Const ROW_START As Long = 7   ' ★必要に応じて 8 に
Private Const ROW_END   As Long = 21

' D列（全体人数）に E+F を書くかどうか（True=書く / False=書かない）
Private Const WRITE_TOTAL_D As Boolean = False
' ================================================

Public Sub 人員集計_店別まとめへ反映()
    Dim wbSummary As Workbook, wbReport As Workbook
    Dim wsSummary As Worksheet, wsReport As Worksheet
    Dim foundCell As Range
    Dim storeName As String
    Dim targetRow As Long
    Dim cntNikkyoYellow As Long        ' E列：日給月給（黄色）
    Dim cntJikankyuuYellow As Long     ' F列：時間給（黄色）
    Dim cntARBColored As Long          ' F列：ARB（任意色）
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    On Error GoTo CLEANUP
    
    ' ====== 対象ブックの取得（開いていなければファイル選択） ======
    Set wbSummary = GetWorkbookByKey(SUMMARY_BOOK_NAME_KEY)
    If wbSummary Is Nothing Then
        Set wbSummary = OpenWorkbookByDialog("店別まとめファイルを選択してください")
        If wbSummary Is Nothing Then
            MsgBox "店別まとめファイルが選択されませんでした。処理を終了します。", vbExclamation
            GoTo CLEANUP
        End If
    End If
    
    Set wbReport = GetWorkbookByKey(REPORT_BOOK_NAME_KEY)
    If wbReport Is Nothing Then
        Set wbReport = OpenWorkbookByDialog("人員報告書ファイルを選択してください")
        If wbReport Is Nothing Then
            MsgBox "人員報告書ファイルが選択されませんでした。処理を終了します。", vbExclamation
            GoTo CLEANUP
        End If
    End If
    
    ' ====== 店別まとめの対象シート ======
    If SUMMARY_SHEET_NAME <> "" Then
        On Error Resume Next
        Set wsSummary = wbSummary.Worksheets(SUMMARY_SHEET_NAME)
        On Error GoTo 0
        If wsSummary Is Nothing Then
            MsgBox "店別まとめの対象シート「" & SUMMARY_SHEET_NAME & "」が見つかりません。", vbExclamation
            GoTo CLEANUP
        End If
    Else
        Set wsSummary = wbSummary.Worksheets(1)
    End If
    
    ' ====== 人員報告書のすべてのワークシートを走査 ======
    For Each wsReport In wbReport.Worksheets
        storeName = Trim$(wsReport.Name)
        If Len(storeName) = 0 Then GoTo CONTINUE_NEXT
        
        ' 店別まとめB列でシート名（店舗名）を検索（完全一致・大文字小文字無視）
        Set foundCell = wsSummary.Columns("B").Find(What:=storeName, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If foundCell Is Nothing Then
            Debug.Print "[未一致] 人員報告書シート名=""" & storeName & """ に合致する店舗名が店別まとめB列に見つかりません。"
            GoTo CONTINUE_NEXT
        End If
        
        targetRow = foundCell.Row
        
        ' ====== ④⑤：按分時間のコピー ======
        On Error Resume Next
        wsSummary.Cells(targetRow, "G").Value = wsReport.Range("BI24").Value  ' 日給月給(按分時間)
        wsSummary.Cells(targetRow, "H").Value = wsReport.Range("BI25").Value  ' 時間給(按分時間)
        On Error GoTo 0
        
        ' ====== ⑥：AX:AY（結合）で「日給月給」かつ黄色塗りのカウント → E列 ======
        cntNikkyoYellow = CountMergedLabeledColored(wsReport, "AX", "AY", ROW_START, ROW_END, "日給月給", True)
        wsSummary.Cells(targetRow, "E").Value = cntNikkyoYellow
        
        ' ====== ⑦：AZ:BA（結合）で「時間給」黄色塗り + BB:BC（結合）で「ARB」任意色塗り → 合算してF列 ======
        cntJikankyuuYellow = CountMergedLabeledColored(wsReport, "AZ", "BA", ROW_START, ROW_END, "時間給", True)
        cntARBColored      = CountMergedLabeledColored(wsReport, "BB", "BC", ROW_START, ROW_END, "ARB", False)
        wsSummary.Cells(targetRow, "F").Value = (cntJikankyuuYellow + cntARBColored)
        
        If WRITE_TOTAL_D Then
            wsSummary.Cells(targetRow, "D").Value = wsSummary.Cells(targetRow, "E").Value + wsSummary.Cells(targetRow, "F").Value
        End If
        
CONTINUE_NEXT:
    Next wsReport
    
    MsgBox "集計が完了しました。", vbInformation

CLEANUP:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub


' === 修正版：結合セルの左上行のみをカウント、色判定を厳密化 ===
Private Function CountMergedLabeledColored( _
    ByVal ws As Worksheet, _
    ByVal colStart As String, _
    ByVal colEnd As String, _
    ByVal rowStart As Long, _
    ByVal rowEnd As Long, _
    ByVal label As String, _
    ByVal yellowOnly As Boolean _
) As Long
    Dim r As Long
    Dim topLeft As Range, mergeArea As Range, checkCell As Range
    Dim v As String
    Dim cnt As Long
    
    For r = rowStart To rowEnd
        Set topLeft = ws.Range(colStart & r)
        
        If topLeft.MergeCells Then
            Set mergeArea = topLeft.MergeArea
            Set checkCell = mergeArea.Cells(1, 1)          ' 結合左上
            ' ★修正：結合が縦方向に伸びているとき、左上行以外ではカウントしない
            If checkCell.Row <> r Then
                GoTo NEXT_R
            End If
        Else
            ' 非結合なら左端セルを代表に
            Set checkCell = ws.Range(colStart & r)
        End If
        
        v = Trim$(CStr(checkCell.Value))
        If StrComp(v, label, vbTextCompare) = 0 Then
            If yellowOnly Then
                If IsYellowFillStrict(checkCell) Then
                    cnt = cnt + 1
                End If
            Else
                If HasAnyFillStrict(checkCell) Then
                    cnt = cnt + 1
                End If
            End If
        End If
NEXT_R:
    Next r
    
    CountMergedLabeledColored = cnt
End Function


' === 黄色の厳密判定（まずは標準黄色のみ） ===
Private Function IsYellowFillStrict(ByVal c As Range) As Boolean
    On Error Resume Next
    If c.Interior.ColorIndex = 6 Then
        IsYellowFillStrict = True
    ElseIf c.Interior.Color = vbYellow Then
        IsYellowFillStrict = True
    Else
        IsYellowFillStrict = False
    End If
    On Error GoTo 0
End Function


' === 「塗りあり」の厳密判定（白/未塗りは除外） ===
Private Function HasAnyFillStrict(ByVal c As Range) As Boolean
    On Error Resume Next
    Dim hasFill As Boolean
    hasFill = (c.Interior.ColorIndex <> xlColorIndexNone) And _
              (c.Interior.Pattern <> xlNone) And _
              (c.Interior.Color <> RGB(255, 255, 255))
    HasAnyFillStrict = hasFill
    On Error GoTo 0
End Function


' すでに開いているブックから、名前にキー文字列を含むものを取得
Private Function GetWorkbookByKey(ByVal keyText As String) As Workbook
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        If InStr(1, LCase$(wb.Name), LCase$(keyText)) > 0 Then
            Set GetWorkbookByKey = wb
            Exit Function
        End If
    Next wb
End Function

' ファイルダイアログを開いてブックを選択・Openして返す
Private Function OpenWorkbookByDialog(ByVal promptText As String) As Workbook
    Dim f As Variant
    f = Application.GetOpenFilename(FileFilter:="Excelファイル (*.xlsx;*.xlsm;*.xls)|*.xlsx;*.xlsm;*.xls", _
                                    Title:=promptText)
    If VarType(f) = vbBoolean And f = False Then
        Set OpenWorkbookByDialog = Nothing
        Exit Function
    End If
    Set OpenWorkbookByDialog = Application.Workbooks.Open(CStr(f))
End Function

■ Gemini

GeminiのVBAコードはこちら

Option Explicit

Sub 人員報告書_集計転記_修正版()
    Dim wsSummary As Worksheet
    Dim wbReport As Workbook
    Dim wsReport As Worksheet
    Dim reportPath As String
    Dim lastRow As Long, i As Long
    Dim storeName As String
    
    ' 1. 「店別まとめ」シートの設定（マクロ実行ファイルの1番目のシート）
    Set wsSummary = ThisWorkbook.Sheets(1)
    
    ' 2. 「人員報告書」を直接指定して開く（エラー52対策）
    ' まずはマクロと同じフォルダにあるか確認
    reportPath = ThisWorkbook.Path & "\人員報告書.xlsx"
    
    On Error Resume Next
    Set wbReport = Workbooks.Open(reportPath)
    On Error GoTo 0
    
    ' もし見つからなければ、手動でファイルを選んでもらう
    If wbReport Is Nothing Then
        MsgBox "「人員報告書.xlsx」を自動で見つけられませんでした。" & vbCrLf & _
               "次の画面で該当のファイルを選択してください。", vbExclamation
        reportPath = Application.GetOpenFilename("Excelファイル,*.xlsx")
        
        If reportPath = "False" Then Exit Sub ' キャンセルされたら終了
        Set wbReport = Workbooks.Open(reportPath)
    End If
    
    ' 3. 集計処理の開始
    lastRow = wsSummary.Cells(Rows.Count, "B").End(xlUp).Row
    
    ' B列2行目から最終行までループ
    For i = 2 To lastRow
        storeName = Trim(wsSummary.Cells(i, "B").Value)
        
        If storeName <> "" Then
            Set wsReport = Nothing
            On Error Resume Next
            Set wsReport = wbReport.Sheets(storeName)
            On Error GoTo 0
            
            If Not wsReport Is Nothing Then
                ' BI24, BI25 の値を転記
                wsSummary.Cells(i, "G").Value = wsReport.Range("BI24").Value
                wsSummary.Cells(i, "H").Value = wsReport.Range("BI25").Value
                
                ' 黄色セルをカウントして転記
                ' E列：日給月給 (AXAY列)
                wsSummary.Cells(i, "E").Value = CountYellowCells(wsReport.Range("AX7:AY21"))
                
                ' F列：時間給+ARB (AZBA列 + BABB列)
                ' ※BABBは前回の推測に基づき BB7:BC21 としています
                wsSummary.Cells(i, "F").Value = CountYellowCells(wsReport.Range("AZ7:BA21")) + _
                                               CountYellowCells(wsReport.Range("BB7:BC21"))
                
                ' D列：全体人数の更新 (E列 + F列)
                wsSummary.Cells(i, "D").Value = wsSummary.Cells(i, "E").Value + wsSummary.Cells(i, "F").Value
            End If
        End If
    Next i
    
    ' 4. 完了処理
    wbReport.Close SaveChanges:=False
    MsgBox "データの転記とD列の合計計算が完了しました！", vbInformation
End Sub

' セルの色が「黄色」かどうかを判定する関数
Function CountYellowCells(rng As Range) As Long
    Dim c As Range, count As Long
    count = 0
    For Each c In rng
        ' 結合セルの左上端のセルだけをチェック（重複カウント防止）
        If c.Address = c.MergeArea.Cells(1).Address Then
            ' 背景色が黄色(ColorIndex 6)か確認
            ' もし「条件付き書式」の色を数えたい場合は DisplayFormat.Interior を使用します
            If c.Interior.ColorIndex = 6 Or c.Interior.Color = RGB(255, 255, 0) Then
                count = count + 1
            End If
        End If
    Next c
    CountYellowCells = count
End Function

VBA作成による業務改善 ＆ AI比較の感想

VBAを作成することによって、手間＆時間がかかったExcel作業がとても楽になりました！

==============

• 最低130回のクリック数　⇒　ワンクリックへ！
• 作業時間 200分＋α　⇒　30秒！
  　　　　　　　　　　　　==============

時間短縮によって、新しいことができる時間も生まれました。

◆ 3つとも比較したAIは、
VBAを作ることに関しては、どれを使っても大きな問題なく、
初心者も簡単に作れると思います。
（個人的な好みでは、Gemini ＞ ChatGPT ＞ Copilotの順）

一回学習させたら、続きで関連する命令も楽楽解決してくれました。
AI 3つともエラーなしで、一発作成完了でした。

まだまだ面倒くさいExcel作業は多いので、
引き続きAIの力を借りてコードを作成していきます。