前回に引き続き、CopilotがあればVBAがめっちゃ便利になるよ！っていう話をしていきたいと思います。実例を用いて説明してみます。
例えば、下記のようなテスト用のファイルとプロンプトを作ってぶん投げてみます。
このファイルを、各部門に所属する担当者をすべてまとめた「1_営業部.xlsx」のような名前で新しくフォルダを作成し、同名のExcelにして保存するようなVBAを作成してください。同じ名前のファイルがある場合は上書きしてください。
これに対して、Copilotは以下のような回答をくれました。
以下のVBAコードを使用して、各部門に所属する担当者をすべてまとめたExcelファイルを作成し、部門ごとに新しいフォルダを作成して保存することができます。同じ名前のファイルがある場合は上書きされます。
Sub SplitWorkbookByDepartment()
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim department As String
Dim cell As Range
Dim newWb As Workbook
Dim newWs As Worksheet
Dim savePath As String
Dim folderPath As String
Dim dict As Object
Dim i As Long
‘ 元のワークブックを開く
Set wb = Workbooks.Open(ThisWorkbook.Path & “\テスト用台帳.xlsx”)
Set ws = wb.Sheets(1)
‘ 最終行を取得
lastRow = ws.Cells(ws.Rows.Count, “A”).End(xlUp).Row
‘ 部門ごとにデータを格納するディクショナリを作成
Set dict = CreateObject(“Scripting.Dictionary”)
‘ データをディクショナリに格納
For i = 2 To lastRow
department = ws.Cells(i, 1).Value
If Not dict.exists(department) Then
dict.Add department, New Collection
End If
dict(department).Add ws.Rows(i)
Next i
‘ 部門ごとに新しいワークブックを作成して保存
For Each department In dict.keys
folderPath = ThisWorkbook.Path & “\” & department
savePath = folderPath & “\” & “1_” & department & “.xlsx”
‘ フォルダが存在しない場合は作成
If Dir(folderPath, vbDirectory) = “” Then
MkDir folderPath
End If
‘ 新しいワークブックを作成
Set newWb = Workbooks.Add
Set newWs = newWb.Sheets(1)
‘ ヘッダーをコピー
ws.Rows(1).Copy Destination:=newWs.Rows(1)
‘ 部門のデータをコピー
For Each cell In dict(department)
cell.Copy Destination:=newWs.Rows(newWs.Cells(newWs.Rows.Count, “A”).End(xlUp).Row + 1)
Next cell
‘ 新しいワークブックを保存
newWb.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook
newWb.Close SaveChanges:=False
Next department
‘ 元のワークブックを閉じる
wb.Close SaveChanges:=False
MsgBox “部門別にファイルが作成されました。”
End Sub
このコードをExcelのVBAエディタに貼り付けて実行することで、各部門に所属する担当者をすべてまとめたExcelファイルを部門ごとに新しいフォルダに保存することができます。何か他にお手伝いできることがあれば教えてください！
しかし、これをそのまま実行するとエラーが発生するので、
下記のようにエラーをそのまま教えてあげます。
For Each department In dict.keysの箇所で、「For Eachに指定する変数はバリアント型またはオブジェクト型でなければなりません。」というエラーが出ます。
すると、ちゃんとその意味を理解して修正したコードを再度回答してくれます。
エラーの原因は、department変数が適切な型として宣言されていないためです。department変数をVariant型として宣言することで、このエラーを解消できます。以下の修正されたコードを試してみてください。
Sub SplitWorkbookByDepartment()
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim department As Variant ‘ Variant型に変更
Dim cell As Range
Dim newWb As Workbook
Dim newWs As Worksheet
Dim savePath As String
Dim folderPath As String
Dim dict As Object
Dim i As Long
‘ 元のワークブックを開く
Set wb = Workbooks.Open(ThisWorkbook.Path & “\テスト用台帳.xlsx”)
Set ws = wb.Sheets(1)
‘ 最終行を取得
lastRow = ws.Cells(ws.Rows.Count, “A”).End(xlUp).Row
‘ 部門ごとにデータを格納するディクショナリを作成
Set dict = CreateObject(“Scripting.Dictionary”)
‘ データをディクショナリに格納
For i = 2 To lastRow
department = ws.Cells(i, 1).Value
If Not dict.exists(department) Then
dict.Add department, New Collection
End If
dict(department).Add ws.Rows(i)
Next i
‘ 部門ごとに新しいワークブックを作成して保存
For Each department In dict.keys
folderPath = ThisWorkbook.Path & “\” & department
savePath = folderPath & “\” & “1_” & department & “.xlsx”
‘ フォルダが存在しない場合は作成
If Dir(folderPath, vbDirectory) = “” Then
MkDir folderPath
End If
‘ 新しいワークブックを作成
Set newWb = Workbooks.Add
Set newWs = newWb.Sheets(1)
‘ ヘッダーをコピー
ws.Rows(1).Copy Destination:=newWs.Rows(1)
‘ 部門のデータをコピー
For Each cell In dict(department)
cell.Copy Destination:=newWs.Rows(newWs.Cells(newWs.Rows.Count, “A”).End(xlUp).Row + 1)
Next cell
‘ 新しいワークブックを保存
newWb.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook
newWb.Close SaveChanges:=False
Next department
‘ 元のワークブックを閉じる
wb.Close SaveChanges:=False
MsgBox “部門別にファイルが作成されました。”
End Sub
この修正により、department変数がVariant型として宣言され、エラーが解消されるはずです。再度実行してみてください。何か他にお手伝いできることがあれば教えてください！
やだ、素敵
ちゃんと伝わってるじゃない。
てな感じで上手く修正してくれます。
こういう系の書類って、割と多いんですよね。
今まではなるべく簡単に後で誰かちょっと詳しい人が見ればわかるだろうくらいの感じで作成していましたが、ここまでAIができれば、もっと多くの人が自分たちで業務改善できそうな気がします。
というか、使い方を教えるから、ちょっと自由にやってみて
っていうこともできると思う。
しかも、ちゃんとコメントを入れてくれているので、
これまで自学で学んでいた人たちなら、応用させていくことも容易になったんじゃないかと感じます。
こういう仕事をやっていて、いまさらなんで恥ずかしいことなんですけど
ちょっと驚いたので書かせていただきました。
ほかの言語もできるようになってそうですね。Pythonとか。
ちゃんと使えば工数激減できそうですね。使いこなしている人とそうでない人の差が激しく出る
っていう意味がちょっと分かりました。
コメント