見出し画像

【ChatGDP】エクセルの自動振り分け機能をVBAで簡単に作れたよ!

ChatGDP、すげーっス。
ということで、今回は、エクセルの自動振り分け機能を作ってみました。

僕がつくりたかったものは、
『売上シートに記入したら、それぞれの取引先ごとに1つのシートを作って、その取引先とだけの取引をかき出す』
というもの。

細かい説明は後で追加するとして、とりあえず、その時のコードを乗せます。

Sub UpdateSalesData()
    Dim salesSheet As Worksheet
    Dim salesRow As Range
    Dim companySheet As Worksheet
    Dim lastRow As Long
    Dim company As String
    
    ' 売上シートを設定
    Set salesSheet = ThisWorkbook.Sheets("売上シート")
    
    ' 取引先リストから取引先を取得
    For Each companySheet In ThisWorkbook.Sheets
        If companySheet.Name <> "売上シート" And companySheet.Name <> "取引先リスト" Then
            ' 取引先のシートのデータを削除
            companySheet.Cells.ClearContents
            ' ヘッダーを再設定(必要ならば)
            If companySheet.Cells(1, 1).Value = "" Then
                companySheet.Cells(1, 1).Value = "日付"
                companySheet.Cells(1, 2).Value = "適用"
                companySheet.Cells(1, 3).Value = "金額"
                companySheet.Cells(1, 4).Value = "消費税"
                companySheet.Cells(1, 5).Value = "落札料"
                companySheet.Cells(1, 6).Value = "落札料の消費税"
                companySheet.Cells(1, 7).Value = "合計金額"
            End If
        End If
    Next companySheet
    
    ' 売上シートの最終行を取得
    lastRow = salesSheet.Cells(salesSheet.Rows.Count, 1).End(xlUp).Row
    
    ' 売上シートの各行を処理
    For Each salesRow In salesSheet.Range("A4:A" & lastRow).Rows
        ' 取引先を取得
        company = salesRow.Cells(1, 2).Value
        
        ' 取引先のシートを確認
        On Error Resume Next
        Set companySheet = ThisWorkbook.Sheets(company)
        On Error GoTo 0
        
        ' 取引先のシートが存在しない場合は新規作成
        If companySheet Is Nothing Then
            Set companySheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            companySheet.Name = company
            ' ヘッダーを再設定
            companySheet.Cells(1, 1).Value = "日付"
            companySheet.Cells(1, 2).Value = "適用"
            companySheet.Cells(1, 3).Value = "金額"
            companySheet.Cells(1, 4).Value = "消費税"
            companySheet.Cells(1, 5).Value = "落札料"
            companySheet.Cells(1, 6).Value = "落札料の消費税"
            companySheet.Cells(1, 7).Value = "合計金額"
        End If
        
        ' データを自動転記
        With companySheet
            lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(lastRow, 1).Value = salesRow.Cells(1, 1).Value ' 日付
            .Cells(lastRow, 2).Value = salesRow.Cells(1, 3).Value ' 適用
            .Cells(lastRow, 3).Value = salesRow.Cells(1, 4).Value ' 金額
            .Cells(lastRow, 4).Value = salesRow.Cells(1, 5).Value ' 消費税
            .Cells(lastRow, 5).Value = salesRow.Cells(1, 6).Value ' 落札料
            .Cells(lastRow, 6).Value = salesRow.Cells(1, 7).Value ' 落札料の消費税
            .Cells(lastRow, 7).Value = salesRow.Cells(1, 8).Value ' 合計金額
        End With
    Next salesRow
    
    MsgBox "データの自動転記が完了しました。"
End Sub





Private Sub Worksheet_Change(ByVal Target As Range)
    ' 変更があったセルが売上シートの対象範囲内であるか確認
    If Not Intersect(Target, Me.Range("B4:H" & Me.Cells(Me.Rows.Count, 1).End(xlUp).Row)) Is Nothing Then
        ' UpdateSalesData マクロを実行
        UpdateSalesData
    End If
End Sub

これで、『売上シート』に『日付、取引先、適用、金額、消費税、落札金額、落札消費税、合計金額』が表示され、それぞれの項目を記入すると、あら不思議、その取引先ごとの新しいシートが自動でできて、その取引先との取引が自動で転記されます。
超らくちん!

僕は会計ソフトも使っていますが、そこから帳票を引っ張ろうとすると、仕分けの形になってしまい、いまいち見づらかったんですよね。

なので、こんなのを作ってみました。
もしよかったら参考にしてみてください。

今は時間がないので、とりあえず、この辺で。
詳しいやり方については、また追記したいと思います。
といっても、ChatGDPさんに質問するだけですけど^^

よろしくお願いします!

いいなと思ったら応援しよう!