2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

【ChatGPT活用】もう無駄な貼付け作業はしない! CSVデータを”ほぼ自動”でExcelに貼付け

Posted at

挨拶

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

今回はどの様にChatGPTを活用し、
どんな作業を自動化できたのかを記事に纏めご紹介いたしますので
最後まで気楽に読んでいただけると幸いです

改善したい業務内容

私は普段、週間報告書(以下:週報)等の資料作成をしております
作成にあたり以下の様な手作業が発生します

  1. CSVデータのダウンロード
  2. 集約用のExcelにCSVデータを貼付け

以上です

『これだけ!?』と拍子抜けに思っている方も居るかもしれませんが

これを店舗の数だけ繰り返します ⇩参考動画

店舗数はそんなに多くないですが、、、デメリットが多いです

デメリット
1.両手が塞がる(拘束時間発生や他事務作業平行不可)
2.店舗が増えたら作業も増える
3.貼付けのミスが許されない

その為、片方だけでも改善したいと思い今回は
2. 集約用のExcelにCSVデータを貼付け
ChatGPTに相談し自動化する事を目的と致します

使用したツール

・ChatGPT  :問題解決の為、様々な要望を受け止めてくれた
       https://chatgpt.com/
・CSVデータ :週報作成の為、ダウンロードしている売上等のデータ
・Excel   :週報作成の為、関数にて売上等を纏めている。
        今回はCSVデータを貼られるだけのツール
・マクロ   :ChatGPTより提案されるソースコードを動かす
        Excel内に搭載

いざChatGPTに質問

画像の様に質問を投げると・・・以下三つの項目が返ってきました

1. 内容の要約
2. 改善方法の提案
3. さらなる詳細を求める質問

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
    
    '--- 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)
            
            '--- AK列をコピーしてシートの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クリック)しよう ⇩参考動画

先ずは動いたことに感動してます:relaxed:

しかし途中で下の様な警告が出ましたね!?これは何故か?

更に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は便利なツールではありますが必ずしも
 正しい回答が返ってくるとは限りません。
 ※しっかり明記されております

 業務外で使用する事ありますが
 実際に間違った答えが返ってくることもありました。
 (好きなアーティストの曲を間違える、ゲームのルール間違い等)

 なので皆さんも利用する際、全てを鵜呑みにはせず
 上手く有効活用してみてください

みなさん、最後まで読んでいただきありがとうございました:pray:
次回の記事もお楽しみに

2
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?