2
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

【VBA × ChatGPT】コピペ作業から解放!売上を1分で自動転記+メール送信するマクロを作ってみた!

Last updated at Posted at 2025-06-25

みなさんこんにちは。3回目の投稿です!
小売業の本社で働いている、デジタル勉強中の会社員です!💻

1、2回目では、業務課題を解決すべくChatGPTを活用しながらMakeやDifyを使って自動化の仕組みを作っていきました。

前回までの記事はこちら👇

今回は、マクロやVBAに関して全く知識のない私が、ChatGPTを駆使しながら毎日行っている「受注実績の転記とメール送信」を1分で終わらせるプロトタイプを作ってみました!

🎬 作ったもの:1クリックで転記&メール送信!

📌 課題:毎日のルーティン業務が10分かかっていた

私の所属するギフトチームでは、受注センターから毎日送られてくる受注実績から対象の企画・部門を絞り、日々担当バイヤーに送っています。
例えば夏ギフトでは、農産・水産・畜産・デイリー・グロサリーなどあらゆる部門があり、それぞれ担当バイヤーが違うのでファイルの中でシートを分けています。
image.png

バイヤーはこの実績表を基に在庫状況を確認し、私たちも各部門の売れ数や推移を把握することができます。

毎日行っている作業の流れは下記の通りです。

image.png

この作業をするのに10分ほどかかっており、月で考えると5時間ほど単純作業に費やしていることになります
たかが10分と思いますが、月にしてみるとかなりの時間使っていますね…。

これをマクロを使って自動化したいと思い、ChatGPTに質問したところ…

  • 1 2はセキュリティの仕様上、VBAでの完全自動化は不可でした。
    ZIP形式で受信→EXE形式の自己解凍ファイルに展開→パスワード入力して開く、という手順の中で、EXEの自動実行はVBAではブロック対象となっているためです。

  • 3 4自動化可能!なのですが、ここで1つ注意点があります。
    メール送信をOutlookで行いたい場合、

新しいOutlook」ではVBAマクロでメール送信ができません!

「新しいOutlook」でマクロを実行してもエラーが出てしまうので、
従来のOutlookclassic)」を使用してください(右側のアイコン)

「新しいOutlook」がVBAを使用できない理由は、"マイクロソフトがセキュリティ強化のため、COMアドイン・マクロからのメール操作を制限しているため" だそうです🤔

【参考】
新しい Outlook と従来の Outlook の機能の比較
新しい Outlook for Windows から切り替える(Microsoft公式)

職場ではOutlookを使用していますが、「新しいOutlook」を使っている人と「従来のOutlookclassic)」を使っている人が混在しているため、下記2パターンを作成しました。

3 の【Excel転記のみパターン
2 + 3 の【Excel転記+メール送信の完全自動パターン

image.png

「新しいOutlook」を使用している人は完全な自動化まではできませんが、受注実績を転記するところまででもかなりの効率化になると思います💡

🛠 使用したツール

  • Excel VBA →初めて使いました!
  • ChatGPT
  • Outlook(クラシック版)

📎マクロ実行までの準備手順と実行方法

準備

1.VBAエディタを開く

  • Excelの「開発」タブ > 「Visual Basic」
  • なければ、[ファイル] > [オプション] > [リボンのユーザー設定] > 「開発」にチェック

2.標準モジュールを挿入

  • [挿入] > [標準モジュール] > Module1が追加されます
  • 後ほど出てきますが、このModuleにChatGPTが作成したVBAコードをいれていくことになります!

3.Outlook連携のため参照設定を追加

  • VBA画面で「ツール」>「参照設定」> Microsoft Outlook XX.X Object Library にチェック ✅※XX.XはOutlookのバージョンによって異なります

image.png

4.元データ(ここでは受注実績のExcelファイル)を開いておく

  • 元データは開いておくだけでOKです

実行方法

  1. ChatGPTが作成したVBAコードを、先ほど準備したVBAエディタのModuleに貼り付ける
  2. マクロ有効ブックにして保存する
  • マクロを実行したいExcelファイルを開き、「ファイル」> 「名前をつけて保存」> フォルダを選択 > ファイルの種類を「Excelマクロ有効ブック」にして保存しておく

3.マクロを実行したいExcelに戻り、開発マクロを選択

※ボタンをつける場合は下記サイト内の「5. マクロの実行を簡略化するマクロ ボタンとは」を参照してください
Excel マクロは難しくない! VBA からマクロ ボタンまで業務効率化の方法を解説

4.マクロ名を選んで実行を押す(または作成したボタンを押す)

これでマクロが実行されます!

✅ 完成したVBAコードの内容

自分でコードを書くのは難しいので、すべてChatGPTに教えてもらったコードを貼り付けて完成させました。

【①Excel転記のみパターン】

まずは、メール送信までは行わずExcel転記のみ行うマクロを作りました。
また、最終的にExcel転記に加え、「マクロなしファイルの自動作成」機能も追加しました!

⑴ 自動転記マクロ

  • カタログ番号元D列/先A列)で一致させる
  • 受注確定数元K列を当日の日付列先2行目)に転記
  • すべてのシートを処理(日付列が見つからなければスキップ)

これらの条件をChatGPTに伝え、できたコードがこちら👇

コードを表示(タップして開く)
Sub 転記_受注確定数_複数シート対応()

    Dim 元ブック As Workbook
    Dim 元シート As Worksheet
    Dim 先ブック As Workbook
    Dim 先シート As Worksheet
    Dim 元最終行 As Long
    Dim 先最終行 As Long
    Dim i As Long
    Dim カタログ番号 As String
    Dim 受注確定数 As Variant
    Dim 日付列 As Long
    Dim 今日 As Date
    Dim セル As Range
    Dim 見つけたセル As Range
    Dim j As Long

    ' ▼現在開いているブックから参照(ファイル名での指定でもOK)
    Set 元ブック = Workbooks("新受注実績-全国カタログ・旬ギフト.xlsx")
    Set 元シート = 元ブック.Sheets(1) ' 1つ目のシート使用
    Set 先ブック = Workbooks("25【夏の贈りもの】単品受注実績(時系列).xlsm")
    
    今日 = Date
    
    元最終行 = 元シート.Cells(Rows.Count, "D").End(xlUp).Row

    ' ▼先ブック内の全シートをループ
    For Each 先シート In 先ブック.Worksheets
        
        ' 2行目(日付)の中から「今日」と一致する列を探す
        日付列 = 0
        For j = 2 To 先シート.Cells(2, Columns.Count).End(xlToLeft).Column
            If IsDate(先シート.Cells(2, j).Value) Then
                If DateValue(先シート.Cells(2, j).Value) = 今日 Then
                    日付列 = j
                    Exit For
                End If
            End If
        Next j
        
        ' 一致する列があれば処理続行
        If 日付列 > 0 Then
            先最終行 = 先シート.Cells(Rows.Count, "A").End(xlUp).Row

            ' 転記元のカタログ番号を1件ずつ処理
            For i = 2 To 元最終行
                カタログ番号 = Trim(元シート.Cells(i, "D").Value)
                受注確定数 = 元シート.Cells(i, "K").Value

                If カタログ番号 <> "" Then
                    ' 転記先で該当のカタログ番号を検索(A列)
                    Set 見つけたセル = 先シート.Range("A2:A" & 先最終行).Find(What:=カタログ番号, LookIn:=xlValues, LookAt:=xlWhole)
                    
                    If Not 見つけたセル Is Nothing Then
                        ' 見つかったら今日の列に受注確定数を転記
                        見つけたセル.Offset(0, 日付列 - 1).Value = 受注確定数
                    End If
                End If
            Next i

        End If
        ' 見つからなければスキップして次のシートへ
    Next 先シート

    MsgBox "すべてのシートへの転記が完了しました!"

End Sub

⑵ 転記済みファイルを「マクロなし」で保存するマクロ

  • 転記が完了すると、自動でマクロなしの .xlsxとして保存する
  • .xlsxファイルにマクロのボタンが残らないようボタンや図形を削除
  • 縦方向を中央揃えにして見た目を整える

これらを何度もChatGPTとやりとりしながら最終的に成功したコードがこちら👇

コードを表示(タップして開く)
Sub 転記_保存_手動送信用_ボタンなし()

    ' 転記処理(既存のマクロ)
    Call 転記_受注確定数_複数シート対応

    ' 保存先ファイル名(元ファイル名の拡張子だけ変更)
    Dim 保存名 As String
    保存名 = "25【夏の贈りもの】単品受注実績(時系列).xlsx"
    
    Dim 保存先 As String
    保存先 = ThisWorkbook.Path & "\" & 保存名

    ' 全シートをコピーして新しいブックを作成(マクロなし)
    ThisWorkbook.Sheets.Copy
    Dim tempBook As Workbook
    Set tempBook = ActiveWorkbook

     ' ボタン削除+縦中央揃え
    Dim s As Worksheet
    For Each s In tempBook.Worksheets
        s.DrawingObjects.Delete ' フォームコントロール削除
        With s.Cells
            .VerticalAlignment = xlCenter ' 縦方向:中央
            '.HorizontalAlignment = xlCenter ' ※必要なら横も中央
        End With
    Next s

    ' ========================================

    ' xlsx形式で保存(マクロなし)
    Application.DisplayAlerts = False
    tempBook.SaveAs Filename:=保存先, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True

    tempBook.Close SaveChanges:=False

    MsgBox "ボタンなしで .xlsx ファイルを保存しました!" & vbCrLf & 保存先, vbInformation

End Sub

⑴と⑵を組み合わせて完成したコードがこちら👇

コードを表示(タップして開く)
Sub 転記_受注確定数_複数シート対応()

    Dim 元ブック As Workbook
    Dim 元シート As Worksheet
    Dim 先ブック As Workbook
    Dim 先シート As Worksheet
    Dim 元最終行 As Long
    Dim 先最終行 As Long
    Dim i As Long
    Dim カタログ番号 As String
    Dim 受注確定数 As Variant
    Dim 日付列 As Long
    Dim 今日 As Date
    Dim セル As Range
    Dim 見つけたセル As Range
    Dim j As Long

    ' ▼現在開いているブックから参照(ファイル名での指定でもOK)
    Set 元ブック = Workbooks("新受注実績-全国カタログ・旬ギフト.xlsx")
    Set 元シート = 元ブック.Sheets(1) ' 1つ目のシート使用
    Set 先ブック = Workbooks("25【夏の贈りもの】単品受注実績(時系列).xlsm")
    
    今日 = Date
    
    元最終行 = 元シート.Cells(Rows.Count, "D").End(xlUp).Row

    ' ▼先ブック内の全シートをループ
    For Each 先シート In 先ブック.Worksheets
        
        ' 2行目(日付)の中から「今日」と一致する列を探す
        日付列 = 0
        For j = 2 To 先シート.Cells(2, Columns.Count).End(xlToLeft).Column
            If IsDate(先シート.Cells(2, j).Value) Then
                If DateValue(先シート.Cells(2, j).Value) = 今日 Then
                    日付列 = j
                    Exit For
                End If
            End If
        Next j
        
        ' 一致する列があれば処理続行
        If 日付列 > 0 Then
            先最終行 = 先シート.Cells(Rows.Count, "A").End(xlUp).Row

            ' 転記元のカタログ番号を1件ずつ処理
            For i = 2 To 元最終行
                カタログ番号 = Trim(元シート.Cells(i, "D").Value)
                受注確定数 = 元シート.Cells(i, "K").Value

                If カタログ番号 <> "" Then
                    ' 転記先で該当のカタログ番号を検索(A列)
                    Set 見つけたセル = 先シート.Range("A2:A" & 先最終行).Find(What:=カタログ番号, LookIn:=xlValues, LookAt:=xlWhole)
                    
                    If Not 見つけたセル Is Nothing Then
                        ' 見つかったら今日の列に受注確定数を転記
                        見つけたセル.Offset(0, 日付列 - 1).Value = 受注確定数
                    End If
                End If
            Next i

        End If
        ' 見つからなければスキップして次のシートへ
    Next 先シート

    MsgBox "すべてのシートへの転記が完了しました!"

End Sub
Sub 転記_保存_手動送信用_ボタンなし()

    ' 転記処理(既存のマクロ)
    Call 転記_受注確定数_複数シート対応

    ' 保存先ファイル名(元ファイル名の拡張子だけ変更)
    Dim 保存名 As String
    保存名 = "25【夏の贈りもの】単品受注実績(時系列).xlsx"
    
    Dim 保存先 As String
    保存先 = ThisWorkbook.Path & "\" & 保存名

    ' 全シートをコピーして新しいブックを作成(マクロなし)
    ThisWorkbook.Sheets.Copy
    Dim tempBook As Workbook
    Set tempBook = ActiveWorkbook

     ' ボタン削除+縦中央揃え
    Dim s As Worksheet
    For Each s In tempBook.Worksheets
        s.DrawingObjects.Delete ' フォームコントロール削除
        With s.Cells
            .VerticalAlignment = xlCenter ' 縦方向:中央
            '.HorizontalAlignment = xlCenter ' ※必要なら横も中央
        End With
    Next s

    ' ========================================

    ' xlsx形式で保存(マクロなし)
    Application.DisplayAlerts = False
    tempBook.SaveAs Filename:=保存先, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True

    tempBook.Close SaveChanges:=False

    MsgBox "ボタンなしで .xlsx ファイルを保存しました!" & vbCrLf & 保存先, vbInformation

End Sub

②【Excel転記+メール送信の完全自動パターン】

次に、先ほど作成したExcel転記に加え、メール送信まで自動で行うようにします。

  • .xlsx を添付してOutlookで送信したい
  • 件名・本文は定型文

また、コードの中で自分で変更が必要なポイントは以下の通りです。

変更箇所 内容
.To = 宛先メールアドレス "example@example.com"
.Subject = メール件名 "【夏の贈りもの】単品受注実績_0625現在"
.Body = 本文(必要に応じて) 挨拶文や部署名などを自社向けに調整
保存名 = ファイル名 "25【夏の贈りもの】単品受注実績(時系列).xlsx"

💡 補足:
送信をテストしたいときは .Send.Display にすれば、メール作成画面だけ表示できます

完成したコードはこちら👇

コードを表示(タップして開く)
Sub 転記_保存_送信_完全自動_整形済()

    ' 元のマクロブックを変数で保持
    Dim macroBook As Workbook
    Set macroBook = ThisWorkbook

    ' 転記処理(複数シート対応)
    Call 転記_受注確定数_複数シート対応

    ' 保存ファイル名とパス(.xlsm → .xlsx)
    Dim 保存名 As String
    保存名 = "25【夏の贈りもの】単品受注実績(時系列).xlsx"
    Dim 保存先 As String
    保存先 = macroBook.Path & "\" & 保存名

    ' マクロブックのシートを新ブックにコピー
    macroBook.Sheets.Copy
    Dim tempBook As Workbook
    Set tempBook = ActiveWorkbook

    ' ボタン削除+縦中央揃え
    Dim s As Worksheet
    For Each s In tempBook.Worksheets
        s.DrawingObjects.Delete ' フォームコントロール削除
        With s.Cells
            .VerticalAlignment = xlCenter ' 縦方向:中央
            '.HorizontalAlignment = xlCenter ' ※必要なら横も中央
        End With
    Next s

    ' .xlsx形式で保存(マクロなし)
    Application.DisplayAlerts = False
    tempBook.SaveAs Filename:=保存先, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    tempBook.Close SaveChanges:=False

    ' Outlookでメール送信
    Dim outlookApp As Object
    Dim mailItem As Object

    On Error Resume Next
    Set outlookApp = GetObject(, "Outlook.Application")
    If outlookApp Is Nothing Then Set outlookApp = CreateObject("Outlook.Application")
    On Error GoTo 0

    If outlookApp Is Nothing Then
        MsgBox "Outlookを起動できませんでした。", vbExclamation
        Exit Sub
    End If

    Set mailItem = outlookApp.CreateItem(0)

    With mailItem
        .To = "example@example.com" ' ←変更してね!
        .Subject = "【夏の贈りもの】単品受注実績_" & Format(Date, "mmdd") & "現在 時系列送付の件"
        .Body = "各位" & vbCrLf & vbCrLf & _
                "毎日の業務、大変お疲れ様です。" & vbCrLf & _
                "夏の贈りもの単品受注実績を送付いたします。" & vbCrLf & vbCrLf & _
                "なお、こちらの受注実績は「産直商品」と「センター出荷商品」の実績となります。" & vbCrLf & _
                "(店出荷商品は○○受注センターに受注が連携されないため、" & vbCrLf & _
                "添付の実績にはございません。)" & vbCrLf & vbCrLf & _
                "※受注データをご確認いただき、限定数に近づいている商品及び、" & vbCrLf & _
                "  商品安定供給に影響が出そうな場合は、早めに" & vbCrLf & _
                " 「○○部 ○○・○○・○○・○○」まで" & vbCrLf & _
                " ご連絡をお願い致します!" & vbCrLf & vbCrLf & _
                "尚、16時までに連絡をいただけますと、○○で自動的に販売終了ができますので" & vbCrLf & _
                "  ご協力をお願いいたします。" & vbCrLf & vbCrLf & _
                "以上、よろしくお願いいたします。"
        .Attachments.Add 保存先
        .Send ' ← .Display にすれば下書き表示も可能
    End With

    MsgBox "保存&メール送信が完了しました!", vbInformation

End Sub

💬ChatGPTとの会話内容

一番最初は、ChatGPTにVBAコードを教えてもらうため、内容を伝えて質問してみました。

すると、どのシートにどの項目を転記させたいか、商品をどの情報で照合するかなど確認したいことを聞いてくれます。

それに対して返答します。

そして教えてくれたコードをVBAエディタに貼り付けて実行すると…
マクロが動いて成功!と思ったら最初のシートにしか反映されておらず、ほかのシートは空欄のまま…。
→「すべてのシートに反映させて」とお願いしたところ、ちゃんと反映させることができました!

💡このように、一度にすべて完璧なものを作るのは難しいので、一つひとつ順を追って要望を伝えていくことで理想に近づいていくと思います!

⚠️ エラーと解決方法

エラー内容 原因 解決法
"Forで指定された変数は既に使用されています" For Eachの変数が重複 別名に変更する(例:swsなど)
マクロボタンを押したらExcelが閉じる ThisWorkbook.Closeなどが含まれている 不要な閉じ処理を削除
Outlookが動かない 新Outlook使用中 クラシックOutlookに戻す or .xlsx保存マクロに切り替える
「潜在的に危険なマクロがブロックされました」 ZIPファイルのまま開いた、または共有フォルダから直接開いた - ファイルを右クリック →「ブロック解除」
- セキュリティセンターで「信頼できる場所」に登録
- .xlsx形式で保存・送信(最も安全)

✋ 実際に使ってもらいました

同じギフトチームの先輩
👨ギフト担当5年目くらいの男性社員(40代)
👩ギフト担当8年目くらいの女性社員(40代)

手順
① 毎日送られてくる受注実績(元データ)を開いておく
② 共有フォルダにいれたマクロありのExcelを開き、ボタンを押す
③ フォルダ内にマクロなしのファイルができます!
※メール送信までの流れは見てもらいましたが、実際にやってもらったのはファイル作成までです。
この手順を説明し、試してもらったところ……

お~すごい(と静かに感動)
👨「元データのExcelは本当に何もいじらなくていいんだよね?
👩「これは2.3日前の分を拾うことはできるの?

と、すかさず冷静な質問が返ってきました。

📝 回答

  • 元データは開くだけでOK! 加工不要です!
  • 2、3日前の分も拾えますが、常に「今日」の列に転記されます
    例えば今日が6/25だとすると、6/24など過去の受注実績でも必ず6/25の列に転記されてしまいます。
    昨日の分拾い忘れた…という場合も想定しないといけないですね。

まだまだ改善の余地がありそうなので、

「日付を指定して引っ張れるようにしたい」
「過去の実績もまとめて転記できるようにしたい」

と希望を伝えたら、

👨「これだけでも十分すごいし、立派な業務改善だよ!無理しないで!」

と、まさかの慰めコメント😅 とっても優しい職場ですね!

🙌 今後やってみたいこと

📌 日付指定・過去の実績を拾うマクロを作成したい
📌 フォーマットの作成も自動化したい
📌 受注実績の自動抽出、生成AIを活用した分析までできるようになりたい
📌 売上集計表の作成と店別売上実績の集計を自動化したい

📝 まとめ

実は今回行った転記からメール送信までの流れは、最近まで業務課題とは思っていませんでした
というのも、10分で終わるので時間がかかっているという感覚がなかったからです。
ですが、最近デジタルを勉強し始めて身近な業務課題を解決していこうとしている中で、当たり前になっている作業を見直す時間ができました

  • 身近な業務課題でサクッと解決できるもの
  • ルーティン化されていて自動化できるもの
    ちょうどこの2つに当てはまったものがまさに今回の例でした。

また、この仕組みを職場で導入することにもなり、自分で作った業務改善ツールを初めて実用化できたことがとても嬉しいです!
先輩社員からは、「こういった業務改善が積み重なることで一人分の仕事が浮くかもしれないよね。」というまさにAIの時代を感じさせる言葉もいただきました。

もちろんこれからもデジタルで業務改善をしていこうと思っていますが、私のようなデジタル初心者でもできるということを周りに認知してもらうことで、"自分もできるかも"と思ってもらえるきっかけになればいいなと考えています。

これからも周りを巻き込みながら、日々業務改善に励んでいきたいと思います💡

💬 ご意見お待ちしてます!

いいね・ストック・コメントいただけると励みになります😊
最後まで読んでいただきありがとうございました!

2
1
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
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?