【新発想】ノーコードでExcelを自動化する無料ツール

コードの知識不要😊 VBAコードを表示する無料アプリです。 ChatGPTの併用で、できることは無限です。

MENU

【ノーコードVBA】データを既存のクロス集計表に転記する

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

例として「データを既存のマトリックス表に転記する」VBAマクロを作成します。

(ページの末尾に、VBAコード掲載)

事例 縦のリスト形式のデータを、既存のクロス集計表に転記する

なお、縦のリスト形式のデータから、新規のマトリックス(集計表)の作成は、エクセルの標準機能のピボットテーブルが簡単です。

アプリの設定

アプリのトップページ 

 ⇒▼表形式の変換

 ⇒リスト形式を

 ⇒【ツール】縦のリスト形式のデータを、既存のマトリックス表に転記する

【ポイント】

 リストの見出しが重複するときに、数字であれば加算や、エラーメッセージを出して中止も可能です。

 

表示されるVBAコード 

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

 

VBAコードを見る

Sub デモ_35() '縦のリスト形式のデータを、既存のマトリックス表に転記する
 Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止

Dim リスト  As Variant, 行見出し As Range, 列見出し As Range
Dim j As Long, 行 As Long, 列 As Long
'リストを配列に入れる
Worksheets("Sheet1").Select
リスト = Range("a1").CurrentRegion.Value
'見出しを取得する
Worksheets("Sheet2").Select
Set 行見出し = Range(Range("b2").Offset(0, -1), Range("b2").Offset(0, -1).End(xlDown))
Set 列見出し = Range(Range("b2").Offset(-1, 0), Range("b2").Offset(-1, 0).End(xlToRight))
'見出しに、項目の漏れがないかチェック
For j = 2 To UBound(リスト, 1)
    If 行見出し.Find(リスト(j, 1)) Is Nothing Then
        MsgBox リスト(j, 1) & vbCrLf & "が見出しにありません。" & vbCrLf & "見出しの漏れと位置を確認してください" & vbCrLf & "終了します"
        Exit Sub
    End If
    If 列見出し.Find(リスト(j, 2)) Is Nothing Then
        MsgBox リスト(j, 2) & vbCrLf & "が見出しにありません。" & vbCrLf & "見出しの漏れと位置を確認してください" & vbCrLf & "終了します"
         Exit Sub
    End If
Next j
'既存データクリア
On Error Resume Next '空白対策
Worksheets("Sheet2").Select
行見出し.Offset(0, 1).Resize(, 列見出し.Columns.Count).SpecialCells(xlCellTypeConstants, 3).ClearContents
On Error GoTo 0
'値を転記
For j = 2 To UBound(リスト, 1)
    行 = 行見出し.Find(リスト(j, 1)).Row
    列 = 列見出し.Find(リスト(j, 2)).Column
    Cells(行, 列).Value = リスト(j, 3)
Next j
Application.DisplayAlerts = True   ' 警告表示を再開
Application.ScreenUpdating = True  ' 画面描画を再開
End Sub

 

ChatGPTで修正

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

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