挨拶
こんにちは! 日々の業務を改善した~いと切に願っている小売業の会社員です
最近、仕事に慣れた事や人材入替り等で身の回りの環境が変わりつつあります。
そこで働き方に対する見直しが必要と思い『自分の手作業を自動化したい』と考えました。
でも一言で『自動化したい』なんて言っても一人で考えることはできないし、
周りの人も忙しいのに時間を割いてもらうのは申し訳ないので
ChatGPTに自分の業務を説明したところ”ほぼ自動化”することができました。
今回はどの様にChatGPTを活用し、
どんな作業を自動化できたのかを記事に纏めご紹介いたしますので
最後まで気楽に読んでいただけると幸いです

改善したい業務内容
私は普段、週間報告書(以下:週報)等の資料作成をしております
作成にあたり以下の様な手作業が発生します
- CSVデータのダウンロード
- 集約用のExcelにCSVデータを貼付け
以上です
『これだけ!?』と拍子抜けに思っている方も居るかもしれませんが
これを店舗の数だけ繰り返します ⇩参考動画
店舗数はそんなに多くないですが、、、デメリットが多いです
デメリット
1.両手が塞がる(拘束時間発生や他事務作業平行不可)
2.店舗が増えたら作業も増える
3.貼付けのミスが許されない
その為、片方だけでも改善したいと思い今回は
2. 集約用のExcelにCSVデータを貼付けを
ChatGPTに相談し自動化する事を目的と致します
使用したツール
・ChatGPT :問題解決の為、様々な要望を受け止めてくれた
https://chatgpt.com/
・CSVデータ :週報作成の為、ダウンロードしている売上等のデータ
・Excel :週報作成の為、関数にて売上等を纏めている。
今回はCSVデータを貼られるだけのツール
・マクロ :ChatGPTより提案されるソースコードを動かす
Excel内に搭載
いざChatGPTに質問
画像の様に質問を投げると・・・以下三つの項目が返ってきました
1. 内容の要約
2. 改善方法の提案
3. さらなる詳細を求める質問


【ソースコード】クリックして見る
Option Explicit
Sub CSVデータ自動集約()
Dim folderPath As String
Dim fileName As String
Dim wbCSV As Workbook
Dim wsCSV As Worksheet
Dim wsTarget As Worksheet
Dim shopID As String
'--- CSVが保存されているフォルダを指定 ---
folderPath = "C:\Users\あなたのフォルダ名\Downloads\" '★必要に応じて変更
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
'--- フォルダ内のCSVファイルを順に処理 ---
fileName = Dir(folderPath & "*.csv")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While fileName <> ""
'--- 店舗番号をファイル名から抽出(最初の4桁) ---
shopID = Left(fileName, 4)
'--- 週報ファイル内のシートを探す ---
On Error Resume Next
Set wsTarget = ThisWorkbook.Sheets(shopID)
On Error GoTo 0
If Not wsTarget Is Nothing Then
'--- CSVを開く ---
Set wbCSV = Workbooks.Open(folderPath & fileName)
Set wsCSV = wbCSV.Sheets(1)
'--- コピー元:A~K列を全行コピー ---
wsCSV.Range("A1:K" & wsCSV.Cells(wsCSV.Rows.Count, "A").End(xlUp).Row).Copy
'--- 貼り付け先:週報シートのA1に上書き(必要に応じて変更可) ---
wsTarget.Range("A1").PasteSpecial xlPasteValues
wbCSV.Close SaveChanges:=False
Debug.Print fileName & " → シート[" & shopID & "] に転記完了"
Else
Debug.Print fileName & " → 対応するシートが見つかりませんでした"
End If
Set wsTarget = Nothing
fileName = Dir() '次のファイルへ
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "全てのCSVファイルを転記しました!", vbInformation
End Sub

正直、ソースコード見ても何となくでしか理解できない💦
そしてフォルダパスについては『★必要に応じて変更』と
個人で修正すべき項目があります。
せっかくなので私はこれすらもChatGPTに書き直してもらおうと思いました
※フォルダパスの調べ方は後述
【改善されたソースコード】 クリックして見る(こっちは後で使います!)
Option Explicit
Sub CSV貼り付けテスト()
Dim folderPath As String
Dim fileName As String
Dim wbCSV As Workbook
Dim wsCSV As Worksheet
Dim wsTarget As Worksheet
Dim shopID As String
'--- フォルダパスを指定(デスクトップの週報データ) ---
folderPath = "C:\Users\■■■■■■■■■\Desktop\週報データ\"
'--- フォルダ内のCSVファイルを順に処理 ---
fileName = Dir(folderPath & "*.csv")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While fileName <> ""
'--- ファイル名の先頭4文字を店舗番号として使用 ---
shopID = Left(fileName, 4)
'--- 週報ファイル内の該当シートを探す ---
On Error Resume Next
Set wsTarget = ThisWorkbook.Sheets(shopID)
On Error GoTo 0
If Not wsTarget Is Nothing Then
'--- CSVを開く ---
Set wbCSV = Workbooks.Open(folderPath & fileName)
Set wsCSV = wbCSV.Sheets(1)
'--- A~K列をコピーして、シートのA1に貼り付け ---
wsCSV.Range("A1:K" & wsCSV.Cells(wsCSV.Rows.Count, "A").End(xlUp).Row).Copy
wsTarget.Range("A1").PasteSpecial xlPasteValues
wbCSV.Close SaveChanges:=False
MsgBox fileName & " → シート「" & shopID & "」に貼り付け完了", vbInformation
Else
MsgBox "シート「" & shopID & "」が見つかりませんでした", vbExclamation
End If
Set wsTarget = Nothing
fileName = Dir() '次のファイルへ
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "全ての貼り付けが完了しました!", vbInformation
End Sub
こっちの要望を明確に指定してあげるとソースコードも直してくれました👏
※ちなみにフォルダパスをコピペする場合は
下の様にフォルダのアドレスをクリックすれば分かりやすいです
動作確認
さてChatGPTとの質疑応答だけで記事が長くなってきましたので
早速『改善されたソースコード』を使用して動作確認していきましょう
ソースコードを入力する為にExcelの『開発』タブから『Visual Basic』をクリック
※もし開発タブが無い場合はAltキー+F11キーでショートカット可

『挿入』タブから『標準モジュール』クリック

コードを入力できる様になるので先程のソースコードをコピペして
フォルダパスを自分の適した内容に手直しすると準備完了です👍

実行(F5クリック)しよう ⇩参考動画
先ずは動いたことに感動してます

更に2点修正
実は最初のソースコードが届いた時点で
もう1箇所直してほしいところがあったんです。
それは店舗コードが4桁だけでなく5桁もあるということ
しかしソースコードを見ると
'--- ファイル名の先頭4文字を店舗番号として使用 ---
shopID = Left(fileName, 4)
多分、ファイル名の左から4番目までの文字をshopID
つまり店舗コードとするという式ですね、、、
これは私がChatGPTに質問する時の写真や『1414』といった具体例を提出した際に
5桁もあるんだよと言わなかったことが要因です
そして実際に動かした上で直してほしい点がもう1箇所増えました
Enterキー(OKを)押さないと進まない!?
動画を見ると分かりますが
これでは手が離せないデメリットに変化がありません。
だいぶ楽にはなりましたがさらに効率良くする為に
ChatGPTへ改善してほしい内容として投げました

【完成されたソースコード】 クリックして見る(すぐ使って確認!)
Option Explicit
Sub CSV貼り付け自動処理()
Dim folderPath As String
Dim fileName As String
Dim wbCSV As Workbook
Dim wsCSV As Worksheet
Dim wsTarget As Worksheet
Dim shopID As String
Dim regEx As Object
Dim match As Object
'--- フォルダパスを指定 ---
folderPath = "C:\Users\■■■■■■\Desktop\週報データ\"
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
'--- 数字を抽出するための正規表現オブジェクト ---
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "^\d{4,5}" ' 先頭4〜5桁の数字を取得
'--- 最初のCSVファイルを取得 ---
fileName = Dir(folderPath & "*.csv")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While fileName <> ""
'--- ファイル名から4〜5桁の数字を抽出 ---
If regEx.Test(fileName) Then
Set match = regEx.Execute(fileName)
shopID = match(0)
Else
shopID = ""
End If
'--- 対応するシートを検索 ---
On Error Resume Next
Set wsTarget = ThisWorkbook.Sheets(shopID)
On Error GoTo 0
If Not wsTarget Is Nothing Then
'--- CSVを開いてデータ貼り付け ---
Set wbCSV = Workbooks.Open(folderPath & fileName)
Set wsCSV = wbCSV.Sheets(1)
wsCSV.Range("A1:K" & wsCSV.Cells(wsCSV.Rows.Count, "A").End(xlUp).Row).Copy
wsTarget.Range("A1").PasteSpecial xlPasteValues
wbCSV.Close SaveChanges:=False
Debug.Print fileName & " → シート[" & shopID & "] に貼り付け完了"
Else
Debug.Print fileName & " → 対応するシートが見つかりません"
End If
Set wsTarget = Nothing
fileName = Dir() ' 次のCSVへ
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "全てのCSV貼り付けが完了しました!", vbInformation
End Sub
自分が想定していた通りの完璧な動作になりました🎉
CSVデータのダウンロードやフォルダパス意識等の問題はありますが
業務内容は大いに改善傾向になります故、
今後もこのソースコードを使っていきます
最後に反省やまとめ
反省点
強いて言うなら何故こんな無駄な作業を〇年間も続けてきたのか?
何故、改善案を考えようとしなかったのかという自分の意識に向けて反省しております
まとめ
1.今回どれだけ効率化に繋がったかという話をします
あの貼付け作業は1月当たり6回前後行います。
1回あたりの作業時間はおよそ30分なので月間で180分使っていました
その作業が動画の様に1回20秒弱で終わるので月間で2分です
今までと比較したら無いに等しいです。
ですが先述したように未だダウンロードをするという作業も残っておりますので
そちらも改善できるように時間を有効活用します
2.ChatGPTは便利なツールではありますが必ずしも
正しい回答が返ってくるとは限りません。
※しっかり明記されております

業務外で使用する事ありますが
実際に間違った答えが返ってくることもありました。
(好きなアーティストの曲を間違える、ゲームのルール間違い等)
なので皆さんも利用する際、全てを鵜呑みにはせず
上手く有効活用してみてください
みなさん、最後まで読んでいただきありがとうございました
次回の記事もお楽しみに