ChatGPTにVBAを作成してもらい、Excel関数を自動入力化

Excel関数を自動入力している様子

みなさん、こんにちは。
紙、印鑑、手作業に埋もれて業務をしている昭和男子の会社員です。
前回、GASを使って、メール送信の自動化をしました。

前回の記事はこちら

Gmailを使用しているため、GASを使いましたが、やはり、業務で一番使用しているのはExcelです。
業務の自動化を進めるなら、Excelマクロは必要ですよね。
ChatGPTの登場で、VBAコードが書けない私でもExcelマクロは作れそーです。
まずは、簡単ではありますが、よく使用するVLOOKUP関数の自動入力のマクロを作りました！

使用するもの

・ChatGPT
・Excel

ChatGPTにVBAのコードを聞く

VBAのコードなんて書けないので、ChatGPTにとにかく聞いてみました。

「○○」と「××」というシートの二つのシートの「C列」と「D列」の間に列を挿入し、その列には「=VALUE(MID(C8,5,5))」の関数を入力したい。Excelのマクロコードを教えてください。

セルC8から空白行になるまで=VALUE(MID(C8,5,5))の数式を入れてください。ただし「8」は変数として行の数字にしてください。

続いて、「××」シートのF7からK7までの範囲をコピーして、「○○」のシートのE列以降の空白列10行目へ貼り付け。同じように「□□」シートから「△△」シートへ貼り付けしたいです。

続いて、「○○」シートに11行目の空白列に「=VLOOKUP($C11,"××"!$D:$K,3,FALSE)」の関数を入力したい。
これを先ほど貼り付けた列までとC列の数値があるまでコピーしたい。
ただし、「$C11」の数値は変数、「3」も列のコピー先のあわせプラス1増やす数値にする最大8となるようにする。
同じように「△△」シートと「□□」シートにおいても同じように行いたい。

聞きまくって、出来たコードがこちらです。

VBAのコード

VLOOKUP関数の自動入力

Sub 統合マクロ()
    Dim wsNames As Variant
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastCol As Long
    Dim firstEmptyCol As Long
    Dim colIndex As Long
    Dim sourceSheetName As String
    Dim formula As String
    Dim info As Variant
    
    ' 処理を行うシート名の配列
    wsNames = Array("○○", "××")
    
    ' 配列内の各シートに対してループ
    For Each wsName In wsNames
        Set ws = ThisWorkbook.Sheets(wsName)
        With ws
            ' C列とD列の間に列を挿入
            .Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            
            ' 空白行までの最終行を見つける
            lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
            
            ' C8から最終行まで数式を入力
            For i = 8 To lastRow
                .Cells(i, "D").formula = "=VALUE(MID(C" & i & ",5,5))"
            Next i
        End With
    Next wsName
    
    ' 各シートの処理をループするための配列
    Dim sheetsInfo(1) As Variant
    sheetsInfo(0) = Array("○○", "××")
    sheetsInfo(1) = Array("□□", "△△")
    
    ' 確定営業項目コピー & VLOOKUP関数の入力
    For Each info In sheetsInfo
        Set wsSource = ThisWorkbook.Sheets(info(1))
        Set wsDest = ThisWorkbook.Sheets(info(0))
        sourceSheetName = wsSource.Name
        
        ' 確定営業項目コピー
        lastCol = wsDest.Cells(10, wsDest.Columns.Count).End(xlToLeft).Column + 1
        wsSource.Range("F7:K7").Copy
        wsDest.Cells(10, lastCol).PasteSpecial Paste:=xlPasteAll
        Application.CutCopyMode = False
        
        ' 11行目の最初の空白列を見つける
        firstEmptyCol = wsDest.Cells(11, wsDest.Columns.Count).End(xlToLeft).Column + 1
        ' C列の最終行を見つける
        lastRow = wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Row
        
        ' VLOOKUP関数の入力
        For i = firstEmptyCol To firstEmptyCol + 5 ' 最大6列にVLOOKUPを適用
            colIndex = i - firstEmptyCol + 3 ' 列インデックスの調整
            If colIndex > 8 Then colIndex = 8 ' 最大値を8に制限
            formula = "=VLOOKUP($C11,'" & sourceSheetName & "'!$D:$K," & colIndex & ",FALSE)"
            
            ' 11行目からC列の最終行まで、計算されたVLOOKUP関数を入力
            wsDest.Range(wsDest.Cells(11, i), wsDest.Cells(lastRow, i)).formula = formula
        Next i
    Next info
    
End Sub

Excelマクロの第一歩

なんといっても業務で一番使用しているExcelの作業を効率化するのが一番！
これからは、どんどんChatGPTに聞いて効率化をしていきたいですね。