*自分用 進捗メモ_2　Excelマクロ

手順についてのメモ記事はこちら↑

＜手順A-1コード＞

Sub ModifyAndOverwrite()
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim leftCell As Range
    Dim lastRow As Long
    
    ' シートの選択
    Set ws = ThisWorkbook.Sheets("実績表")
    ws.Copy After:=Sheets(Sheets.Count)
    Set newWs = ActiveSheet
    
    ' 1行目の削除
    ws.Rows("1").Delete
        
    ' 1行目にフィルタ設定
    ws.Rows(1).AutoFilter
    
    ' C列の追加
    ws.Columns("C:C").Insert Shift:=xlToRight
    
    ' 列名入力とセル書式の設定
    ws.Cells(1, 3).Value = "突合用の店舗コード"
    ws.Cells(2, 3).NumberFormat = "General"
    
   ' 突合用の店舗コードの入力とオートフィル
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    ws.Cells(2, 3).Formula = "=IF(ISNUMBER(SEARCH("" "", B2)), B2, MID(B2, 1, 5))"
    ws.Cells(2, 3).AutoFill Destination:=ws.Range(ws.Cells(2, 3), ws.Cells(lastRow, 3))
       

    ' ファイルの上書き保存
    Application.DisplayAlerts = False ' 上書き保存の確認ダイアログを表示しない
    ws.Parent.Save
    Application.DisplayAlerts = True  ' 設定を元に戻す
    
    ' エクセルを閉じる
    Application.Quit
End Sub

手順変更
・手順「7」の突合用の店舗コード生成の関数を変更することで「12」までの手順をカット
・マクロ実行後は上書き保存して終了

ChatGPTへのプロンプト　手順A-1

プロンプト　手順A-1

・このプロンプトで書き出されたマクロを何度か試して、おかしい動きの部分をひとつひとつ修正

・エラーが出るたび、どこまではできてるのか動作を確認してエラー箇所を特定

・プロンプト上の項番「8」に無理があるようなので、「6」の関数を変更
MID関数ではなく、IF関数を用いてISNUMBER,SEARCHと組み合わせて目的とする動作を実現できたので「8」から「11」までをカット

・終わり部分は最初の予定と変えたので、上書き保存して閉じるで終了に変更

---

＜手順A-2コード＞

Sub ModifyAndOverwrite()
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim lastRow As Long
    
    ' シートの選択
    Set ws = ThisWorkbook.Sheets("店舗別集計")
    ws.Copy After:=Sheets(Sheets.Count)
    Set newWs = ActiveSheet
    
    ' 1行目と2行目の削除
    ws.Rows("1:2").Delete
        
    ' 1行目にフィルタ設定
    ws.Rows(1).AutoFilter
    
    ' C列の追加
    ws.Columns("C:C").Insert Shift:=xlToRight
    
    ' 列名入力とセル書式の設定
    ws.Cells(1, 3).Value = "突合用の店舗コード"
    ws.Cells(2, 3).NumberFormat = "General"
    
    ' 突合用の店舗コードの入力
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    ws.Cells(2, 3).Formula = "=MID(B2,5,5)"
    ws.Cells(2, 3).AutoFill Destination:=ws.Range(ws.Cells(2, 3), ws.Cells(lastRow, 3))
    
    ' ファイルの上書き保存
    Application.DisplayAlerts = False ' 上書き保存の確認ダイアログを表示しない
    ws.Parent.Save
    Application.DisplayAlerts = True  ' 設定を元に戻す
    
    ' エクセルを閉じる
    Application.Quit
End Sub

ChatGPTへのプロンプト　手順A-2

プロンプト　手順A-2

マクロスタート動作を変更
手順A-2-6からスタート
・元データから対象のシートを切り出すのをやめる
・元データには複数シートがあり複雑なシートが含まれてるため
・元データには手を加えたくないため
・対象シートの切り出し＆デスクトップ保存は人がやる
・マクロ実行後は上書き保存して終了

---

コードを入れるところ

・Alt+F11で「VBA」を開く
・対象のシート名をダブルクリックで画面右側に開く標準モジュールにマクロコード入力

*実行方法
表示タブからマクロ実行
または図形にマクロを登録してワンクリックで実行
ショートカットキー登録など色々あり
追々追記予定

結果

微々たる作業だが業務手間を省けた
次の手順への下準備程度の作業ではあるが、手順の標準化には繋がるかな