エクセルデータの並べ替えに関して

質問

エクセルデータの並べ替えに関して

Ａ列からＨ列まで数値が入っていて、それが8,000行くらいあります。(毎回変動します。)
Ａ1からＨ8000くらいのセルに値が入っています。

エクセルを縦長に使用しているので、このまま印刷をすると印刷面の右側半分以上が空白に
なってしまいます。

マクロを利用して、これらの値を96行ごとに２列分けたいと思っていますが、どうやったら
良いか、教えていただけないでしょうか。

（マクロ実行前）--------------
　Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ　Ｇ　Ｈ
１ 1 2 3 4 5 6 7 8　
２ 2 3 4 5 6 7 8 9
３ 3 4 5 6 7 8 9 10
４ 4 5 6 7 8 9 10 11
・・・・・・
----------------------------
のように下方向に数字が並んでいる場合、マクロを実行したら
次のようにしたいと思っています。
（マクロ実行後）--------------
　Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ　Ｇ　Ｈ　（Ｉ）　Ｊ　Ｋ　Ｌ　Ｍ　Ｎ　Ｏ　Ｐ　Ｑ
１ 1 2 3 4 5 6 7 8（１行空き）97 98 99 100 101 102 103 104
２ 2 3 4 5 6 7 8 9（１行空き）98 99 100 101 102 103 104 105
３ 3 4 5 6 7 8 9 10（１行空き）99 100 101 102 103 104 105
４ 4 5 6 7 8 9 10 11（１行空き）100 101 102 103 104 105 106
・・・
９６ 96 97 98 99 100 101 102 103（１行空き）192 193 194 195 196 197 198 199
９７ 193 194 195 196 197 198 199 200（１行空き）289 290 291 292 293 294 295 296
・・・・・・
----------------------------
(1)A1からH96までを切り取って、J1に貼り付ける。
(2)「(1)」で切り取って出来た空欄を削除して上方向にシフトする。
(3)A97からH192までを切り取って、J97に貼り付ける。
(4)「(2)」で切り取って出来た空欄を削除して上方向にシフトする。
といった操作を「切り取って出来た空欄を削除して上方向にシフトする。」という操作を
しようとしたら上方向にシフトするデータがなくなるところまで続けたいと
思っています。

回答No.2

mu2011 · ベストアンサー

NO1です。
sheet1、sheet2はオブジェクトでシートタブ名ではありませんので、紛らわしかったと思いますので以下のコードをお試しください。
因みにデータの空白は意識していませんのでエラーとは関係ありません。

Sub test()
cc = Val(InputBox("分割行数を入力して下さい。", "分割行数の入力", 96))
If cc < 8 Then Exit Sub
Set a = Worksheets("sheet1") '元データシート
Set b = Worksheets("sheet2") '印刷用シート

last = a.Cells(Rows.Count, 1).End(xlUp).Row / cc
If a.Cells(Rows.Count, 1).End(xlUp).Row Mod cc Then
last = last + 1
End If
For i = 1 To last
If i Mod 2 Then
b.Cells(1, 1).Offset(((i - 1) \ 2) * cc).Resize(cc, 8).Value = _
a.Cells(1, 1).Offset((i - 1) * cc).Resize(cc, 8).Value
Else
b.Cells(1, 10).Offset(((i - 1) \ 2) * cc).Resize(cc, 8).Value = _
a.Cells(1, 1).Offset((i - 1) * cc).Resize(cc, 8).Value

End If
Next
End Sub

お礼

ありがとうございます。

少し進みました。

ただ、ＡＢＣＤ列の情報は指定した行ごとにＪＫＬＭ列に移るのですが、
ＥＦＧＨ列の情報がなくなってしまいました。

マクロを使い始めて半年くらいの身では、解読しにくく、
ステップインで実行したところ次の部分でＥＦＧＨ列のデータがなくなってしまいました。
b.Cells(1, 1).Offset(((i - 1) \ 2) * cc).Resize(cc, 8).Value = _
a.Cells(1, 1).Offset((i - 1) * cc).Resize(cc, 8).Value

この辺りを少し詳しく教えていただけませんか？

補足

いろいろ調べながら作成しています。

分割行数に200を入れると、4,001行目から下のデータが残っている。
分割行数に100を入れると、3,901行目から下のデータが残っている。
分割行数に50を入れると、3,851行目から下のデータが残っている。
という問題点が出てきました。

もう少し調べてみます。

回答No.4

mu2011

NO2です。

>分割行数に200を入れると、4,001行目から下のデータが残っている。
>分割行数に100を入れると、3,901行目から下のデータが残っている。
>分割行数に50を入れると、3,851行目から下のデータが残っている。
>という問題点が出てきました。

>ただ、ＡＢＣＤ列の情報は指定した行ごとにＪＫＬＭ列に移るのですが、
>ＥＦＧＨ列の情報がなくなってしまいました。

　⇒回答しましたコードをそのまま貼り付けて頂ければこのような事はないのですが。
　　同様のデータを使ってシミュレートしてもそのような振舞になりません。
　　因みに動作環境は、win XP、エクセル２００７です。　　　

>ステップインで実行したところ次の部分でＥＦＧＨ列のデータがなくなってしまいました。
>b.Cells(1, 1).Offset(((i - 1) \ 2) * cc).Resize(cc, 8).Value = _
>a.Cells(1, 1).Offset((i - 1) * cc).Resize(cc, 8).Value

　⇒奇数回はA1、偶数回はJ1を基準にCC行数×８列分を範囲コピーしているだけです。

回答No.3

kuma56

>マクロを利用して、これらの値を96行ごとに２列分けたいと思っていますが、どうやったら良いか、教えていただけないでしょうか
マクロについて勉強してください・・・・っていう答えは？
このサイトはマクロの作成依頼はその主旨にそぐわないことはお存知ですね？
マクロについての解説サイトもWEB上で容易に見つける事が出来ると思います。
さらに、エクセルには"マクロの記録"という機能があり、手作業で行った結果をマクロに記録してくれます。
質問文の作業をある程度繰り返す所までこの機能で記録してみましょう。
相対参照と絶対参照をうまく使い分けると、途中から同じ記述が繰り返されるようになります。
その部分は " Do Loop " 等を使って繰り返してやればひとまとめにして一回の記述で済みます。
ただしこのままではずっと繰り返されてしまうので、作業の区切りになる所（質問の場合は　上方向にシフトするデータがなくなるところ）で " IF " で条件分岐させて終わらせてやればいいでしょう。
答えは一つだけとは限らず、先にデータを二行に並べ替えてから印刷する方法や、印刷する一ページ分だけデータを並べて繰り返す方法なども可能でしょう。

>(1)A1からH96までを切り取って、J1に貼り付ける。
・・・ん？　↑この作業は必要ですか？？
>(3)A97からH192までを切り取って、J97に貼り付ける。
J1セルに張り付ける　では？

回答No.1

mu2011

一例です。
別シートに並び替える方法ですが如何でしょうか。
仮にデータをsheet1として、sheet2タブ上で右クリック→コードの表示→以下のコードを貼り付け、マクロ実行でsheet2に並び替えします。
因みに分割行数を入力する様にしています。（ディフォルト９６行で８行未満は無効）

Sub test()
cc = Val(InputBox("分割行数を入力して下さい。", "分割行数の入力", 96))
If cc < 8 Then Exit Sub

last = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row / cc
If Sheet1.Cells(Rows.Count, 1).End(xlUp).Row Mod cc Then
last = last + 1
End If
For i = 1 To last
If i Mod 2 Then
Sheet2.Cells(1, 1).Offset(((i - 1) \ 2) * cc).Resize(cc, 8).Value = _
Sheet1.Cells(1, 1).Offset((i - 1) * cc).Resize(cc, 8).Value
Else
Sheet2.Cells(1, 10).Offset(((i - 1) \ 2) * cc).Resize(cc, 8).Value = _
Sheet1.Cells(1, 1).Offset((i - 1) * cc).Resize(cc, 8).Value

End If
Next
End Sub

補足

集計前のシート名を「Sheet1」として、新しく「Sheet2」という名前のシートを
入れて、「Sheet2」上で教えていただいたマクロを実行しました。

すると、下のエラーが出ました。
「実行時エラー'424':
オブジェクトが必要です。」

「デバック」を押すと、次の部分がフォーカスされました。
Sheet2.Cells(1, 1).Offset(((i - 1) \ 2) * cc).Resize(cc, 8).Value = _
Sheet1.Cells(1, 1).Offset((i - 1) * cc).Resize(cc, 8).Value

「Sheet1」の元データのＡ列に空欄が何度も出てくることが原因でしょうか。