エクセルで一列に並んだ数字を折り返したい

質問

エクセルで一列に並んだ数字(4000行あります)を印刷範囲内で折り返しをしたいのですが簡単な方法はないでしょうか？

(例)
　　　　A　　B　　C　　D　　　　　　　　　A　　B　　　C　　　D
１　　０１　　　　　　　　　→　　　１　０１　０５　０９　　

２　　０２　　　　　　　　　　　　　２　０２　０６　１０

３　　０３　　　　　　　　　　　　　３　０３　０７　１１

４　　０４　　　　　　　　　　　　　４　０４　０８　１２

～　　　　　　　　　　　　　　　　　～　

4000　4000

回答No.1

noname#52504 · ベストアンサー

元のデータがA1以下にあるとします。

●決まった行数（例えば４行）毎に折り返す場合

B1セルを、
　==IF(ROW()>4,"",OFFSET($A$1,(COLUMN()-1)*4+ROW()-1,))
として４行目までフィル⇒B1:B4を右方にフィル⇒コピー⇒値貼り付け⇒不要な行を削除

●【[印刷範囲]として設定されたセル範囲の行数】で折り返す場合

B1セルを、
　=IF(ROW()>ROWS(Print_Area),"",OFFSET($A$1,(COLUMN()-1)*ROWS(Print_Area)+ROW()-1,))
として下方・右方にフィル⇒コピー⇒値貼り付け⇒不要な行を削除

-------------------------------------------------------

もし、「１ページ目の行数を自動で判定して…」といった話であれば、
VBA(マクロ)の領域になります。

お礼

出来ました！ありがとうございます。

回答No.2

zap35

＞印刷範囲内で折り返しをしたいのですが
マクロでやってみました。最初に１頁の行数を求めて、その行数で切って３列に並べ替えます。（元のページをコピーしたシートに並べ替えた結果を出します）

以下のマクロをALT＋F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。マクロの実行はワークシート画面に戻ってALT＋F8でマクロ一覧を開き、マクロ名を選択して「実行」ボタンです。

Sub Macro1()
Dim pLines, ptr As Integer
Dim idx As Long
　　Application.ScreenUpdating = False
　　ActiveSheet.Copy Before:=ActiveSheet
　　Do
　　　　pLines = pLines + 1
　　Loop Until Rows(pLines).PageBreak <> xlNone
　　pLines = pLines - 1
　　ptr = 1
　　idx = 1
　　Do While idx <= Range("A65536").End(xlUp).Row
　　　　Cells(ptr, "A").Resize(pLines, 1).Value = Cells(idx, "A").Resize(pLines, 1).Value
　　　　Cells(ptr, "B").Resize(pLines, 1).Value = Cells(idx + pLines, "A").Resize(pLines, 1).Value
　　　　Cells(ptr, "C").Resize(pLines, 1).Value = Cells(idx + pLines * 2, "A").Resize(pLines, 1).Value
　　　　ptr = ptr + pLines
　　　　idx = idx + pLines * 3
　　Loop
　　Range(Cells(ptr, "A"), Range("A65536").End(xlUp)).ClearContents
　　Application.ScreenUpdating = True
End Sub

お礼

出来ました！ありがとうございます。