【ﾉｰｺｰﾄﾞVBA】1行のデータを複数行に分ける (original) (raw)
エクセルVBAマクロを自動作成する無料アプリです。
例として、アプリで「1データ1行のデータを1データ2行に分ける」VBAマクロを作成します。
事例 1明細1行のリストを、1データ2行にする
マクロを実行すると、1データ2行になりました。
アプリの設定
アプリへのリンク ⇒縦のリスト形式のデータを、1データ複数行(2行)の表にする
【ポイント】
■ 【３】元データの１データの行数は、行見出しが無い場合0を入れてください。
表示されるVBAコード
アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。
VBAコードを見る
Sub デモ() '縦のリスト形式のデータを、1データ複数行(2行)の表にする
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False ' 警告表示を停止
Dim セル範囲 As String, セル As Range
Sheets("Sheet1").Select
'表の最終行を決定
Dim 最終行 As Long
最終行 = Cells(Rows.Count, Range("A1").Column).End(xlUp).Row
セル範囲 = "a1" & ":" & Cells(最終行, Range("f1").Column).Address(False, False)Dim 表 As Variant, i As Long, j As Long, 行 As Long, 列 As Long, 出力先 As Range
表 = Range(セル範囲).Value
ReDim 配列((UBound(表, 1) * UBound(表, 2) - UBound(表, 1) * 0) / 3 - 1, 0 + 3 - 1)
For i = 1 To UBound(表, 1)
For j = 0 + 1 To UBound(表, 2)
If 列 = 3 Then
列 = 0
行 = 行 + 1
配列(行, 列 + 0) = 表(i, j)
列 = 列 + 1
Else
配列(行, 列 + 0) = 表(i, j)
列 = 列 + 1
End If
Next
Next
Set 出力先 = Sheets("sheet1").Range(" h1 ").Resize(UBound(配列, 1) + 1, UBound(配列, 2) + 1)
出力先 = 配列
On Error Resume Next
出力先.Borders.LineStyle = True '表に罫線をいれる
出力先.SpecialCells(xlCellTypeConstants, xlNumbers).Style = "Comma [0]" '表の数字にカンマをいれる
出力先.SpecialCells(xlCellTypeConstants, xlNumbers).HorizontalAlignment = xlRight '表の数字を右揃えにする
Application.DisplayAlerts = True ' 警告表示を再開
Application.ScreenUpdating = True ' 画面描画を再開
End Sub
見出しのある事例はこちら
ChatGPTで修正
あなたが自動化したい内容と事例が少し異なる場合は、無料で使えるマイクロソフトの「BingAIチャット」でコードを修正します。とても簡単です！