エクセル 大量のデータを各行に分割して表示する

質問

エクセルに不慣れなため教えていただけたら幸いです。
A列にデータが並んでいます。
値は機械からの測定値で小数点を含む数字です。
データ数は測定回ごとに異なります。

この測定値を複数行に分割して表示したいと思います。
表示する際は1行当たりのデータ数が測定回ごとに異なります。
データ量が多いため、コピペではなく簡単に表示できたら助かります。

仮に画像は20件のデータを、１行当たりのデータ数を5件として表示していますが、測定ごとに1行当たりのデータ数も異なります。
1行当たりのデータ数はM1のセルに入れています。

わかりづらい説明で申し訳ありませんが、何か良い方法があればお伺いできれば助かりますのでよろしくお願いいたします。

回答No.5

kkkkkm · ベストアンサー

回答No.2の追加です。

回答No.2のVBAのコードはこちらの方がいいのかなと思ったりしました。

Sub Test2()
Dim i As Long
Dim mRow As Long, mCol As Long

With Sheets("Sheet2")

.Range("E3").CurrentRegion.ClearContents

mRow = 3: mCol = Columns("E").Column

For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row Step .Cells(1, "M").Value
.Cells(mRow, mCol).Resize(.Cells(1, "M").Value, 1).Value = _
.Cells(i, "A").Resize(.Cells(1, "M").Value, 1).Value
mCol = mCol + 1
Next

End With

End Sub

お礼

ご回答ありがとうございました。 無事想定通りの結果が確認できました。

Powered by GRATICA

回答No.4

NuboChan

すいません。
ゴミを含んで書き込みしてしまいました
Sub SplitData2()　は捨ててください。

回答No.3

NuboChan

もっと簡単になるでしょうが配列を利用して作成しました。

Option Explicit

Sub SplitData2()
Dim ws As Worksheet
Dim lastRow As Long
Dim 分割数 As Long
Dim i As Long, ii As Long
Dim j As Long, jj As Long
Dim ターゲットセル() As Variant
Dim 分割先 As Range

' Set the worksheet
Set ws = ThisWorkbook.Sheets("Sheet1") ' Change the sheet name as needed

' Find the last row in column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Set the source range (A3 to the last row)
ReDim ターゲットセル(1, lastRow)

For i = 1 To lastRow
ターゲットセル(1, i) = Cells(i, 1)
Next i

' Set the destination range (starting from E3)
'Set 分割先 = ws.Range("E3")

' Determine the number of columns (M1 value)
分割数 = ws.Range("M1").Value

j = 0
jj = 0
' Loop through the data and split into columns
For j = 1 To 分割数
ws.Range("E3").Offset(jj, j - 1).Value = ターゲットセル(1, j).Value
j = j + 1
Next ii
End Sub

Sub A列分割()

' 最終行を取得
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row

'分割数
Dim sep As Long
sep = Range("M1")

' 2次元配列のサイズ
Dim arr() As Variant
ReDim arr(1 To Int(lastRow / sep) + 1, 1 To sep)

' 配列に値を格納
Dim i As Long, j As Long, k As Long
k = 1
For i = 1 To UBound(arr, 1)
For j = 1 To UBound(arr, 2)
If k <= lastRow Then
arr(i, j) = Cells(k, "A").Value
k = k + 1
Else
arr(i, j) = 0
End If
Next j
Next i

' E3セルに結果を出力
For i = 1 To UBound(arr, 1) - 1
For j = 1 To UBound(arr, 2)
Cells(j + 2, i + 4).Value = arr(i, j)
Next j
Debug.Print
Next i
End Sub

回答No.2

kkkkkm

関数でしたら
E3に
=IF(ROW()>$M$1+2,"",A1)
として下にM1の記載される可能性のある数値＋2行目までコピー
F3に
=IF(ROW()>$M$1+2,"",INDIRECT("A" & COLUMN(A1)*$M$1+ROW(A1)))
として下と右に値を表示する可能性のある範囲にコピー
で試してみてください。

マクロでしたら

Sub Test()
Dim i As Long
Dim mRow As Long, mCol As Long

With Sheets("Sheet2") '実際のシート名に

.Range("E3").CurrentRegion.ClearContents
'他のデータがE列及び3行目と隣り合わせにならないようにしてください。

mRow = 3: mCol = Columns("E").Column

For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If mRow > 2 + .Cells(1, "M").Value Then
mRow = 3
mCol = mCol + 1
End If
.Cells(mRow, mCol).Value = .Cells(i, "A").Value
mRow = mRow + 1
Next

End With

End Sub

で試してみてください。

回答No.1

SI299792

Microsoft365
=WRAPCOLS(A1:A100,M1)
（A100は実データに合わせて変更して下さい。）

Excel2021
=INDEX(A:A,TRANSPOSE(SEQUENCE(20,M1)))
（これで20行迄表示、実データに合わせて変更して下さい。）

Excel2019 以前
E3: =IF(ROW()<$M$1+3,OFFSET($A1,(COLUMN()-5)*$M$1,0),"")
右下へコピペ。

最近、バージョンがいくつもあるので苦労します。
バージョンは書いて下さい。

お礼

ご回答ありがとうございました。 以後バージョンの記入を行うようにいたします。

Powered by GRATICA