【ChatGPT×VBA】データを項目別のシートに分ける

データを項目別のシートに分ける

データをA列の商品名ごとに各シートに分けます。

ChatGPTのプロンプト

以下のVBAコードを作成できますか？
マクロ名は「 デモ 」とし、変数は、それが必要となる直前で宣言する。また、日本語でコメントをいれる。
概要：セル範囲の「 1列目 」でフィルターし、その結果ごとにシートを作成する。
手順：
・「 データ 」シートの「 A1 」セルから「 C2 」セルの最終行までをセル範囲として設定する。
・Scripting.Dictionaryオブジェクトを作成し、セル範囲の「 １列目 」の各行（見出し行を除く）に対してキーを作成する。キーがまだ辞書に存在しない場合、そのキーを辞書に追加する。
・辞書のすべてのキーをループする。
　・セル範囲にフィルタを適用する。フィールドはセル範囲の「 １列目 」、Criteria1にキーを指定する。
　・すべてのワークシートをループし、キーに一致するシート名の存在を確認する。
　　・一致する場合、以下の操作を行う：
　　　・キーに対応するシートの内容をクリアする。　　
　　　・セル範囲をコピーする。
　　　・キーに対応するシートの「A1」セルに貼り付ける。
　　・一致するシートがない場合、以下の操作を行う：
　　　・新しいシートを追加し、その名前を現在のキーに設定する。
　　　・次に、セル範囲をコピーし、新しいシートの「 A1 」セルに貼り付ける。
　　　・新しいシートの列幅を自動調整する。
・最後に、セル範囲にフィルタを解除し、クリップボードをクリアする。
・コードの最初に画面の更新と警告の表示を停止し、コードの最後でそれらを再開する。

（ポイント１）上の「プロンプトをコピーする」ボタンで、コピーできます。

（ポイント２）ChatGPTに貼り付けて、緑色の単語を、あなたの処理に合わせて修正します。内容の削除や追加もできます。
(注：プロンプトの全てを読む必要はありません。緑色の行のみ集中して読み、修正してください）

（ポイント３）会話のスタイルは、「より厳密に」を選択します。

（ポイント４）プロンプトの改行は、ShiftキーとEnterキーを同時に押します。

ChatGPTの回答

もちろんです。以下に指定の条件に基づいたVBAコードを示します：

Sub デモ()
    ' 画面の更新と警告の表示を停止
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("データ")

    Dim rng As Range
    Set rng = ws.Range("A1:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    ' セル範囲の１列目の各行に対してキーを作成
    Dim cell As Range
    For Each cell In rng.Columns(1).Cells
        If cell.Row > 1 And Not dict.exists(cell.Value) Then
            dict.Add cell.Value, Nothing
        End If
    Next cell

    Dim key As Variant
    For Each key In dict.keys
        ' セル範囲にフィルタを適用
        rng.AutoFilter Field:=1, Criteria1:=key

        Dim sheetExists As Boolean
        sheetExists = False

        ' すべてのワークシートをループし、キーに一致するシート名の存在を確認
        Dim sht As Worksheet
        For Each sht In ThisWorkbook.Sheets
            If sht.Name = key Then
                sheetExists = True
                ' キーに対応するシートの内容をクリア
                sht.Cells.Clear
                ' セル範囲をコピー
                rng.SpecialCells(xlCellTypeVisible).Copy
                ' キーに対応するシートのA1セルに貼り付け
                sht.Range("A1").PasteSpecial
                Exit For
            End If
        Next sht

        If Not sheetExists Then
            ' 新しいシートを追加し、その名前を現在のキーに設定
            Set sht = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            sht.Name = key
            ' セル範囲をコピー
            rng.SpecialCells(xlCellTypeVisible).Copy
            ' 新しいシートのA1セルに貼り付け
            sht.Range("A1").PasteSpecial
            ' 新しいシートの列幅を自動調整
            sht.Columns.AutoFit
        End If
    Next key

    ' セル範囲にフィルタを解除
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    ' クリップボードをクリア
    Application.CutCopyMode = False

    ' 画面の更新と警告の表示を再開
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

プロンプトを作成し、VBAコードを実行してみて！　ChatGPT凄い！！😊

VBAマクロを無料のChatGPT（Microsoft Copilot）で作成します。

Copilot(https://copilot.microsoft.com)はログイン不要。すぐVBAマクロが完成します。