【ノーコード】1分でExcelを自動化する無料ツール

コードの知識不要😊ChatGPTしようぜ⚾17

MENU

【ノーコードVBA】複数行にまたがるデータを1行にまとめる

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

例として「複数行にまたがるデータを1行にまとめ 」VBAマクロを作成します。

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

事例 複数行にまたがるデータを1行にまとめる

 

類似する処理です。

アプリの設定

アプリの設定です。

アプリのトップページ 

⇒▼表形式の変換

⇒【ツール】複数行のデータを、項目別に 1 行にまとめる

表示されるVBAコード 

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

 

VBAコードを見る

Sub デモ() '縦1列のデータを、等間隔で、複数列や複数行に分ける
 Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止
Dim セル範囲 As String, セル As Range, 右下セル As String    Dim 入力シート As Worksheet, 出力シート As Worksheet, 項目列 As Long, データ列 As Long, 開始行 As Long, 最終行 As Long
    Dim コピー先行 As Long, コピー先列 As Long, 入力行 As Long, 項目 As Range, データ As Range
    Set 入力シート = Sheets("Sheet1")
    Set 出力シート = Sheets("Sheet1")
    項目列 = 入力シート.Range("a2").Column
    データ列 = 入力シート.Range("b2").Column
    開始行 = 入力シート.Range("a2").Row
    最終行 = 入力シート.Cells(入力シート.Rows.Count, 項目列).End(xlUp).Row
    コピー先行 = 出力シート.Range("d1").Row
    コピー先列 = 出力シート.Range("d1").Column
    
    ' 入力データを一行ずつ処理
    For 入力行 = 開始行 To 最終行
        Set 項目 = 入力シート.Cells(入力行, 入力シート.Range("a2").Column)
        Set データ = 入力シート.Cells(入力行, 入力シート.Range("b2").Column)
        Dim 出力行 As Long, 出力最終列 As Long
        ' 出力先のシートで該当する項目の行を探す
        On Error Resume Next
        出力行 = 出力シート.Columns(コピー先列).Find(項目).Row
        If Err.Number <> 0 Then
            ' 該当する項目が見つからない場合は新しい行を追加
            If 出力シート.Cells(コピー先行, コピー先列).Value = "" Then
                出力行 = コピー先行
            Else
                出力行 = 出力シート.Cells(Rows.Count, コピー先列).End(xlUp).Row + 1
            End If
            出力シート.Cells(出力行, コピー先列).Value = 項目.Value
            ' 背景色をコピー
            出力シート.Cells(出力行, コピー先列).Interior.Color = 項目.Interior.Color
        End If
        On Error GoTo 0
        ' 空いている列にデータを追加
        出力最終列 = 出力シート.Cells(出力行, Columns.Count).End(xlToLeft).Column
        出力シート.Cells(出力行, 出力最終列 + 1).Value = データ.Value
        ' 背景色をコピー
        出力シート.Cells(出力行, 出力最終列 + 1).Interior.Color = データ.Interior.Color
    Next 入力行
Application.DisplayAlerts = True   ' 警告表示を再開
Application.ScreenUpdating = True  ' 画面描画を再開
End Sub

 

ChatGPTで修正

コードの改変は、無料で使えるマイクロソフトの「BingAIチャット」を使います。
とても簡単です!

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