事務職の「めんどくさい」をChatGPT×VBAで解決！重複削除・メール送信を自動化した話

Sub 重複削除()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim deleteCount As Long
    Dim dict As Object

    Set ws = ThisWorkbook.Sheets("顧客リスト")  ' シート名を変更してください
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    deleteCount = 0

    ' Dictionaryオブジェクトで重複チェック（下から処理して新しいデータを優先）
    Set dict = CreateObject("Scripting.Dictionary")

    For i = lastRow To 2 Step -1
        Dim key As String
        key = LCase(Trim(ws.Cells(i, 1).Value))

        If key = "" Then
            GoTo NextRow
        End If

        If dict.exists(key) Then
            ws.Rows(i).Delete
            deleteCount = deleteCount + 1
        Else
            dict.Add key, True
        End If

NextRow:
    Next i

    MsgBox deleteCount & " 件の重複データを削除しました。", vbInformation, "完了"
End Sub

Sub メール一括送信()
    Dim ws As Worksheet
    Dim outlookApp As Object
    Dim mail As Object
    Dim lastRow As Long
    Dim i As Long
    Dim companyName As String
    Dim personName As String
    Dim mailAddress As String
    Dim amount As String

    Set ws = ThisWorkbook.Sheets("送信リスト")  ' シート名を変更してください
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' 送信前に確認
    Dim result As Integer
    result = MsgBox(lastRow - 1 & " 件のメールを送信しますか？", vbYesNo + vbQuestion, "送信確認")
    If result = vbNo Then Exit Sub

    Set outlookApp = CreateObject("Outlook.Application")

    For i = 2 To lastRow
        companyName = ws.Cells(i, 1).Value
        personName  = ws.Cells(i, 2).Value
        mailAddress = ws.Cells(i, 3).Value
        amount      = Format(ws.Cells(i, 4).Value, "#,##0")

        Set mail = outlookApp.CreateItem(0)
        With mail
            .To = mailAddress
            .Subject = "【ご請求】" & Month(Now) & "月分のご請求金額についてのご連絡"
            .Body = personName & " 様" & vbCrLf & vbCrLf & _
                    "いつも大変お世話になっております。" & vbCrLf & _
                    companyName & " の担当、暮らしラボ事務局です。" & vbCrLf & vbCrLf & _
                    "今月分のご請求金額をお知らせいたします。" & vbCrLf & _
                    "------------------------------" & vbCrLf & _
                    "　ご請求金額：" & amount & " 円（税込）" & vbCrLf & _
                    "------------------------------" & vbCrLf & vbCrLf & _
                    "ご不明な点がございましたら、お気軽にご連絡ください。" & vbCrLf & _
                    "どうぞよろしくお願いいたします。"
            .Send  ' 即送信。確認してから送りたい場合は .Display に変更
        End With

        Set mail = Nothing
    Next i

    MsgBox lastRow - 1 & " 件のメールを送信しました。", vbInformation, "完了"
    Set outlookApp = Nothing
End Sub