エクセルVBA作成のChatGPTプロンプト文例集

ChatGPTプロンプト、VBAコードをコピペできます😊

MENU

クロス集計表をリスト形式にする

エクセルVBAマクロを自動作成する無料アプリです。

例として「クロス集計表をリスト形式に変換する」VBAマクロを作成します。

事例 クロス集計表を、リスト形式にします。

マクロを実行すると、リスト形式になりました。



できました!😀

 

アプリの設定

アプリのトップページ

 ⇒▼表形式の変換

 ⇒リスト形式へ

 ⇒【ツール】マトリックス表(ピボット形式)を、縦のリスト形式に転記

 

【ポイント】

 転記後に右端列が空欄の行を削除できます。

 

表示されるVBAコード 

アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。

 

VBAコードを見る

Sub デモ() '縦のリスト形式にする
 
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止
Dim 元シート As Worksheet, 先シート As Worksheet, 左上行 As Long, 左端列 As Long
Dim 表左上行 As Long, 表左上列 As Long, 右下行 As Long, 右端列 As Long, セル範囲 As Range
'◆初期値の設定
Set 元シート = Worksheets("Sheet1")
Set 先シート = Worksheets("Sheet1")
元シート.Select
左上行 = Range("c2").Row
左端列 = Range("c2").Column
表左上行 = Range("c2").End(xlUp).Row
表左上列 = Range("c2").End(xlToLeft).Column
Range("c2").CurrentRegion.Select
右下行 = Selection(Selection.Count).Row
右端列 = Selection(Selection.Count).Column
Set セル範囲 = Range(Cells(左上行, 左端列), Cells(右下行, 右端列))
Dim 見出し列 As Range, 見出し行 As Range
Set 見出し列 = Range(Cells(左上行, 左端列 - 1), Cells(右下行, 表左上列))
Set 見出し行 = Range(Cells(表左上行, 左端列), Cells(左上行 - 1, 右端列))
Dim 表データ As Variant, データ1行 As Variant, データ全行 As Variant, 現在行 As Long, 元の行数 As Long
'◆表を2次元配列に格納
表データ = セル範囲
'◆2次元配列を1行づつ、1次元配列へ格納
For 元の行数 = 1 To 右下行 - 左上行 + 1
    データ1行 = WorksheetFunction.Index*1.Copy
    先シート.Select
    Selection.Resize(右端列 - 左端列 + 1, 1).PasteSpecial Paste:=xlPasteAll
    Selection.Offset(右端列 - 左端列 + 1, 0).Select
Next
'◆見出し行コピー
元シート.Select
見出し行.Copy
先シート.Range("h1").Offset(0, (左端列 - 表左上列)).Resize(UBound(データ全行) + 1, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
'◆データ全行を、1列に書き込み
先シート.Range("h1").Offset(0, (左端列 - 表左上列) + (左上行 - 表左上行)).Resize(UBound(データ全行) + 1, 1).Value _
= WorksheetFunction.Transpose(データ全行)
'◆データ全行に書式
元シート.Select
Cells(右下行, 右端列).Copy
先シート.Range("h1").Offset(0, (左端列 - 表左上列) + (左上行 - 表左上行)).Resize(UBound(データ全行) + 1, 1).PasteSpecial Paste:=xlPasteFormats
先シート.Select
Application.CutCopyMode = False
'◆空白の行を削除
Dim 転記先最終行 As Long, 転記先最終列 As Long, 行 As Long, 削除範囲 As Range
転記先最終行 = 先シート.Range("h1").End(xlDown).Row
転記先最終列 = 先シート.Range("h1").End(xlToRight).Column
For 行 = 転記先最終行 To Range("h1").Row Step -1
    If Cells(行, 転記先最終列).Value = "" Then
        If 削除範囲 Is Nothing Then
            Set 削除範囲 = Range(Cells(行, Range("h1").Column), Cells(行, 転記先最終列))
        Else
            Set 削除範囲 = Union(削除範囲, Range(Cells(行, Range("h1").Column), Cells(行, 転記先最終列)))
        End If
    End If
Next 行
If Not 削除範囲 Is Nothing Then 削除範囲.Delete Shift:=xlUp
Application.DisplayAlerts = True   ' 警告表示を再開
Application.ScreenUpdating = True  ' 画面描画を再開
End Sub

 

同じ項目のセットが、横に複数列繰り返される場合はこちら

【ノーコードVBA】横持ちの表を縦持ちに変換する

 

ChatGPTで修正

あなたが自動化したい内容と事例が少し異なる場合は、無料で使えるマイクロソフトの「BingAIチャット」でコードを修正します。とても簡単です!

アプリはこちらから↓↓↓↓ 

*1:表データ), 元の行数)
    'データ全行に、各データ1行を結合。区切り文字は"|"
    If 元の行数 = 1 Then
        データ全行 = Split(Join(データ1行, "|"), "|")
    Else
       データ全行 = Split(Join(データ全行, "|") & "|" & Join(データ1行, "|"), "|")
    End If
Next 元の行数
'◆見出し列コピー
先シート.Select
Range("h1").Select
For 現在行 = 左上行 To 右下行
    元シート.Select
    元シート.Range(Cells(現在行, 表左上列), Cells(現在行, 左端列 - 1