Chat GPT × Excel VBA
今回も「Chat GPT」を使って、どんな感じで「Excel VBA」プログラムが作成できるか試していきたいと思います。
「在庫表」を整える
前回、「在庫表」の「入力セル」の
「分類」
「商品番号」
「商品名」
の入力をリストにするVBAを作成しました。
今回は、「商品番号」が入力されると、残りのデータを「在庫表」テーブルより検索して自動で表示するVBAを作成していきます。
「商品番号」を入力すると残りのデータを自動入力する
セルC8を入力するとその他の値を自動入力(不備あり？)
①ChatGPTに依頼。
「セルC8が入力された値と同じ「在庫表」テーブルの2列目の値を検索し、同じ行の1列目と3から8列目の値をセルB8とD8からI8に表示するVBAを作成してください。
また、対象のテーブルの行の背景色を薄い黄色にしてください」
上記だけでは、背景色を解除するコマンドが無かったので、
「VBA実行の最初にテーブルの背景色を解除するプログラムも追加する」
ように依頼しました。
②作成されたVBAをシートモジュールにコピペ。
③「入力セル」の「商品番号」(セルC8)の値を変更してみる。
下のように入力セルのその他の項目が入力され、テーブルの対象行の背景が黄色くなりました。
【実際のプログラム】
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tbl As ListObject
Dim searchValue As String
Dim foundRow As Range
Dim i As Long
Dim row As Range
' 変更されたセルがC8でなければ終了
If Target.Address <> "$C$8" Then Exit Sub
' 「在庫表」テーブルから入力された値を検索
Set tbl = Me.ListObjects("在庫表")
searchValue = Target.Value
' ハイライトを解除する
tbl.DataBodyRange.Interior.ColorIndex = xlNone
Set foundRow = Nothing
For Each row In tbl.DataBodyRange.Rows
If row.Cells(2).Value = searchValue Then
Set foundRow = row
Exit For
End If
Next row
' 該当する行が見つかった場合、1列目と3-8列目の値をセット
If Not foundRow Is Nothing Then
For i = 1 To 7 ' 列BからIまでの値をセット
Me.Cells(8, i + 1).Value = foundRow.Cells(i).Value
Next i
' 背景色を変更する
foundRow.Interior.Color = RGB(255, 255, 153) ' 薄い黄色
Else
' 該当する行が見つからなかった場合、セルをクリアしてハイライトも解除する
Me.Range("B8:I8").ClearContents
End If
End Sub
ただし、上記のVBAを実行するとなぜか処理に時間がかかり、古いPCを使用するとエクセルが再起動などしてしまいました。
セルC8を入力するとその他の項目を自動入力する(改善版)
①ChatGPTに依頼。
「上のVBAを処理を軽くするVBAに変更してください」
上の依頼で、新たなVBAの作成と、下のように修整箇所を教えてくれました。
ChatGPTの回答
この修正例では、以下のような改善点があります。
Scripting.Dictionaryを使わず、ループで行を探す方法に変更しました。Range.Valueではなく、Range.Cells.Valueで値を取得するように変更しました。- ループ内でオブジェクトの参照を減らすため、行ごとに
tableRange.Rows(i)を使って、必要な行のみを参照するように変更しました。 - データを取得する際に
Offsetメソッドを使わず、Index関数を使ってデータを取得するように変更しました。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
②作成されたVBAを再度シートモジュールにコピペ。
③「入力セル」の「商品番号」(セルC8)の値を変更してみる。
こちらも問題なく処理ができました。
【実際のプログラム】
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tbl As ListObject
Dim searchValue As String
' Dim foundRow As Range
' Dim i As Long
Dim row As Range
' 変更されたセルがC8でなければ終了
If Target.Address <> "$C$8" Then Exit Sub
' Dim searchValue As String
Dim foundRow As Range
Dim tableRange As Range
Dim i As Long
' テーブルを取得する
Set tableRange = Sheet1.ListObjects("在庫表").Range
' 検索値を取得する
searchValue = Sheet1.Range("C8").Value
' 背景色を解除する
tableRange.Interior.ColorIndex = xlNone
' テーブル内を検索する
For i = 1 To tableRange.Rows.Count
' 2列目の値が検索値と一致する行を探す
If tableRange.Cells(i, 2).Value = searchValue Then
' 背景色を変更する
tableRange.Rows(i).Interior.Color = RGB(255, 255, 153) ' 薄い黄色
' データを表示する
Sheet1.Range("B8").Value = tableRange.Cells(i, 1).Value ' 1列目
Sheet1.Range("D8:I8").Value = Application.Index(tableRange.Cells(i, 3).Resize(1, 6).Value, 1, 0) ' 3から8列目
Exit For
End If
Next i
End Sub
因みに上記2つのVBAに「Timer」を組み込んで処理時間を確認してみました。
【不備あり？プログラム】 処理時間：0.08秒
【改善版】 処理時間：0.16秒
なぜか、「Timer」を組み込んだりしているうちに、「不備あり？」プログラムも問題なく動作して、結果としては逆転した処理時間となってしまいました。
この件に関しては私は？？？です。
まだまだVBAのわからないところです。
あとがき
今回は、「商品番号」を入力することで、その他の項目が自動入力されるVBAを作成しました。
処理時間については？？？が残る結果ですが、ChatGPTでも「改善したプログラム」とのことなので、今後も「改善版」のVBAを使用していきます。
次回は、「在庫表」を整える4 データの連携
の続きで、「商品名」を入力したときでも残りのデータを自動入力するVBAを作成したいと思います。