Excel VBAもChatGPTにおまかせ！月度別営業データを抽出せよ！

問題が発生してから言うのよねぇ・・・

どうも、アラ還サラリーマンです。
とある地方の某小売業の会社で、店舗運営全般を統括する部署の管理部門の担当をしています。
管理部門では、店舗事務方のサポートやデータ管理などなど、多岐にわたる業務を担当しています。

よく店舗事務方から、「仕入の数値が変です！」とか「在庫数値がマイナスになってます！」とか、さまざまな問い合わせを受けます。
そんな時、「いつからですか？　さかのぼって調べてください！」とはいうものの、店舗事務方も忙しい・・・。

毎月、確定した営業データは手元にあるので、月度をさかのぼって自分で調査してみよう！

しかし当社システムは月度別の時系列データが抜けない！

そうなんです。単月や半期、年度の累計の確定した営業データは抜けるのに、
月度別の時系列データが抜けません！

月度別の時系列データを作成するには、各月度の営業データをコピペするしかないのです。
めんどくさいなぁ・・・。

Excel VBAも多少は触れたことがある自分。
ChatGPT先生に聞きながら、月度別営業データ抽出マクロをつくっていきましょう！
イメージはこんな感じかな・・・。

実際にできた動画がこちら！

操作方法

• 時系列抽出.xlsm の シート名：結果 のプルダウンから、
  【店舗コード:店舗名】、【分類コード:分類名】、開始【年】【月】、終了【年】【月】を選びます。
• 【データ抽出】ボタンを押すと月度別の時系列データが完成！
• 用が済んだら、【データ消去】ボタンを推して、きれいさっぱりサヨウナラ！

今回使用したツール

・ChatGPT・・・頼れる先生！
・Excel VBA・・・月度別の営業データを抽出します。

まずプルダウンをつくってみよう！

さっそく先生に聞いてみます。

おおっ、出た出た！
では、時系列抽出.xlsm の シート名：マスタ にリストを作成、シート名：結果 にプルダウンを作成と。

開始年月から終了年月までの月度を格納する配列は？

先生！　出番です！

先生が教えてくれたVBAコード例

Sub CreateMonthArray()
    ' 開始日と終了日を定義します
    Dim startDate As Date
    Dim endDate As Date
    
    startDate = DateSerial(2024, 1, 1)  ' 2024年1月
    endDate = DateSerial(2024, 5, 1)    ' 2024年5月
    
    ' 月度の配列を定義します
    Dim monthArray() As String
    Dim monthCount As Integer
    Dim i As Integer
    
    ' 開始日から終了日までの月数を計算します
    monthCount = DateDiff("m", startDate, endDate) + 1
    
    ' 配列のサイズを動的に設定します
    ReDim monthArray(1 To monthCount)
    
    ' 配列に月度を格納します
    For i = 0 To monthCount - 1
        monthArray(i + 1) = Format(DateAdd("m", i, startDate), "yyyy年mm月")
    Next i
    
    ' 配列の内容を表示
    For i = LBound(monthArray) To UBound(monthArray)
        Debug.Print monthArray(i)
    Next i
End Sub

上記のVBAコードの実行結果

こういうのがほしかったんですよ！
なるほど！フォーマットを変えれば、ファイル名を指定できるな！

【店舗コード】と【分類コード】で検索したい！

先生！　甘えていいですか？

先生が教えてくれたVBAコード例

Sub FindMatchingRow()
    Dim ws As Worksheet
    Dim searchValueA As String
    Dim searchValueB As String
    Dim lastRow As Long
    Dim i As Long
    Dim foundRow As Long
    
    ' 対象のシートを指定（例: アクティブなシートを使用）
    Set ws = ActiveSheet
    
    ' 検索する値を指定
    searchValueA = "検索するAの値"
    searchValueB = "検索するBの値"
    
    ' A列とB列の最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 初期化
    foundRow = -1
    
    ' A列とB列をループして値を検索
    For i = 1 To lastRow
        If ws.Cells(i, 1).Value = searchValueA And ws.Cells(i, 2).Value = searchValueB Then
            foundRow = i
            Exit For
        End If
    Next i
    
    ' 結果を表示
    If foundRow <> -1 Then
        MsgBox "一致する行番号: " & foundRow
    Else
        MsgBox "一致する値が見つかりませんでした。"
    End If
End Sub

力技っぽいけどわかりやすい！

フォルダの中のファイルを開いて、処理させるには？

前提条件として、時系列抽出.xlsmと同じフォルダ内にあるフォルダの中のファイルを操作したいのです。
教えてください、先生！

Sub ProcessFilesInFolder()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim folderPath As String
    Dim fileName As String
    Dim filePath As String
    
    ' マクロファイルと同じ場所にある "DataFiles" フォルダのパスを設定
    folderPath = ThisWorkbook.Path & "\DataFiles\"
    
    ' フォルダ内の最初のファイルを取得
    fileName = Dir(folderPath & "*.xlsx")
    
    ' フォルダ内のファイルをループ
    Do While fileName <> ""
        ' ファイルのフルパスを作成
        filePath = folderPath & fileName
        
        ' ファイルを開く
        Set wb = Workbooks.Open(filePath)
        
        ' 処理を行う（例: 最初のシートのセルA1に「処理済み」と入力）
        Set ws = wb.Sheets(1)
        ws.Range("A1").Value = "処理済み"
        
        ' 処理が完了したらファイルを保存して閉じる
        wb.Close SaveChanges:=True
        
        ' 次のファイル名を取得
        fileName = Dir
    Loop
    
    MsgBox "すべてのファイルが処理されました。"
End Sub

いいねぇ。ただ今回は配列で格納した年月のファイルを開いて処理したいから、使えるとこだけいただきますか！

そして完成したVBAコードがこちら！

Sub 時系列抽出()
    Dim tenpoCode As String, bunruiCode As String
    Dim startYear As Integer, startMonth As Integer, endYear As Integer, endMonth As Integer
    Dim monthArray() As String
    Dim monthCount As Integer, i As Integer
    Dim startDate As Date, endDate As Date
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim folderPath As String, fileName As String, filePath As String
    Dim lastRow As Long, ri As Long, foundRow As Long, startRow As Long
    
    Application.ScreenUpdating = False          '画面更新の停止
    
    With ThisWorkbook.Worksheets("結果")
        startRow = 5        '入力開始行
        tenpoCode = Left(.Cells(2, 1), 5)       'A2から5桁の店舗コードを取得
        bunruiCode = Left(.Cells(2, 3), 3)      'C2から3桁の分類コードを取得
        startYear = .Cells(2, 5)                'E2の開始年
        startMonth = .Cells(2, 6)               'F2の開始月
        endYear = .Cells(2, 8)                  'H2の終了年
        endMonth = .Cells(2, 9)                 'I2の終了月
        
        startDate = DateSerial(startYear, startMonth, 1)    ' 開始日
        endDate = DateSerial(endYear, endMonth, 1)          ' 終了日
    
        monthCount = DateDiff("m", startDate, endDate)      ' 開始日から終了日までの月数を計算
        ReDim monthArray(monthCount)    ' 配列のサイズを動的に設定

        For i = 0 To monthCount
            monthArray(i) = Format(DateAdd("m", i, startDate), "yyyymm")
        Next i

        ' マクロファイルと同じ場所にある "営業データ" フォルダのパスを設定
        folderPath = ThisWorkbook.Path & "\営業データ\"
        
        For i = 0 To monthCount         ' 配列の内容分繰り返し処理
            foundRow = -1       ' 初期化
            fileName = monthArray(i) & "営業データ.xlsx"    ' ファイル名を作成
            filePath = folderPath & fileName    ' ファイルのフルパスを作成
            
            If Dir(filePath) = "" Then          ' ファイルがなければジャンプ
                GoTo jmp
            End If
                
            Set wb = Workbooks.Open(filePath)   ' ファイルを開く
            Set ws = wb.Sheets(1)               ' データが入力されているシートを設定
            
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row    ' A列の最終行を取得
            
            For ri = 1 To lastRow       ' A列(店舗コード)とC列(分類コード)をループして値を検索
                If ws.Cells(ri, 1).Value = tenpoCode And ws.Cells(ri, 3).Value = bunruiCode Then
                    foundRow = ri
                    
                    '時系列抽出.xlsmのB～L列に検索結果をコピペ
                    ws.Range("A" & foundRow & ":K" & foundRow).Copy .Cells(startRow, 2)
                    Exit For
                End If
            Next ri
            
            wb.Close SaveChanges:=False     ' 処理完了後、ファイルを保存しないで閉じる
            
jmp:
            .Cells(startRow, 1) = monthArray(i)     '時系列抽出.xlsmのA列(年月)に検索年月を入力
            If foundRow = -1 Then
                .Cells(startRow, 2) = "一致する値が見つかりませんでした。"
            End If
            
            startRow = startRow + 1         ' 入力開始行の更新
        Next i
    End With
    Application.ScreenUpdating = True       '画面更新の停止を戻す
    
    MsgBox "時系列抽出処理完了しました！"
End Sub

Sub 入力範囲消去()
    Dim lastRow As Long

    With ThisWorkbook.Worksheets("結果")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row    ' A列の最終行を取得
        .Range("A5:L" & lastRow).ClearContents
        .Range("A2:K2").ClearContents
    End With
End Sub

該当する営業データファイルがない場合のジャンプ処理を加えています。
ほぼほぼ先生が教えてくれたVBAコード例を加工してできました！
プルダウンの値と抽出したデータを消去するVBAコードも追加しています。
操作しやすいよう、【データ抽出】と【データ消去】のボタンにマクロの登録をしています。

ChatGPT先生にうまく教えてもらおう！

今回、先生が教えてくれた中では、日付の処理と配列に格納するVBAコード例が、特に感動しました。自分では思いつかなかったでしょう。
教えてもらうコツとして、何がやりたいかを細かく明確にすることが肝心だと思いました。
機能ごとに分けた方が、よいVBAコード例を提示してくれるような気がしました。
ただし、先生のVBAコード例だけをつないでも、うまくいくことは稀なので、Excel VBAも多少は理解していることに越したことはないでしょう。
Excel VBAももう少し勉強するか！
とにかく完成したぞ！　先生に感謝！！

ではでは、今日はこのへんで！