エクセルで複数列を二列にまとめる

質問

エクセルのデータ成形に、知恵を貸していただけますでしょうか・・・

エクセルで以下のようなデータがあります(例では8行8列) コードは本当はランダムです。
#と右下の部分は空白セルです。横には数字、コード、数字、コードの並びで、数字は一行目のみです。

1 aa-1 2 bb-1 3 cc-1 4 dd-1
# aa-2 # bb-2 # cc-2 # dd-2
# aa-3 # bb-3 # cc-3
# aa-4 # bb-4
# aa-5 # bb-5
# aa-6
# aa-7
# aa-8

これらを

1 aa-1
1 aa-2
1 aa-3
.
.
2 bb-1
2 bb-2
.
.
4 dd-2

というように
1.　複数の列を２列ずつのグループで２列にまとめ
2. それぞれのグループごとに各コードの左のセルにグループの数字をつけたい
　　（どのコード(aa-1など)がどの数字グループなのか分かるように）

と思っています。

なにかいい方法はありますでしょうか。

調べてはみたのですが、
複数列を一列ではなく、二列ずつまとめていることや、
各列の長さが一様ではないことなどから
各所で紹介されている方法が適用できないでおります。
VBAもほとんど使ったことがないので、それらを応用できません。

どうぞ知恵を貸していただけたらと思います。
よろしくお願い致します。

回答No.2

tom04 · ベストアンサー

こんばんは！

何とか関数で！と思ってやりかけたのですが・・・
ギブアップです！

そこでVBAでの一例です。
Sheet1に元データがあり、Sheet2に表示するようにしてみました。
※　Sheet2は全く使用していないという前提です。
※　そしてSheet1のデータは1行目からあるとしています（列数はいくつでも構いません）

画面左下のSheet1のSheet見出し上で右クリック　→　コードの表示　→　VBE画面がでますので
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt+F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i, j As Long
Dim ws As Worksheet
Set ws = Worksheets("sheet2")
ws.Cells.Clear
With ws.Cells(1, 1)
.Value = "数字"
.HorizontalAlignment = xlCenter
.Offset(, 1) = "コード"
.HorizontalAlignment = xlCenter
End With
Application.ScreenUpdating = False
For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column Step 2
i = Cells(Rows.Count, j + 1).End(xlUp).Row
Range(Cells(1, j), Cells(i, j + 1)).Copy
ws.Select
ws.Cells(Rows.Count, 2).End(xlUp).Offset(1, -1).Select
ActiveSheet.Paste
Next j
For i = 2 To ws.Cells(Rows.Count, 2).End(xlUp).Row
If ws.Cells(i, 1) = "" Then
ws.Cells(i, 1) = ws.Cells(i - 1, 1)
End If
Next i
Application.ScreenUpdating = True
ws.Columns("A:B").AutoFit
ws.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
End Sub 'この行まで

参考になれば良いのですが・・・m(_ _)m

お礼

ご回答ありがとうございます。

いえ、関数だと大変そう、というのは承知しておりますので、
すぐには内容を理解できませんが、マクロで大丈夫です。ありがとうございます。

試してみましたが、理想通りの出力が得られました。
しばらくこれを手作業でちまちまやっていたのが嘘のようです。
マクロだとできるのだろうな、と思っていたのですが、やはりできるのですね。

VBAを勉強するコストとちまちまやるコストを秤にかけて
これまで避けてきたのですが、
このエレガントさを目の当たりにして、やはり、VBAをがんばることにいたします。

RとPerlにも手を出そうとしているのですが、
・・・少し気が遠くなりそうです。笑
お二人に書いていただいたプログラムの内容を理解できる日が早くくればいいなと思います。

ご回答ありがとうございました。

補足

みなさま、素晴らしい回答をくださり
ベストアンサーを選びがたいので、
今回は最初にまとまった形でマクロを作ってくださったtom04様にさせていただきます。
みなさま、ありがとうございました。

回答No.5

某HN クロメート(Chromate)（@CoalTar）

#4ですマクロにも挑戦してみた
データシートがSheet1、編集後がSheet2として

Sub 桜()
Dim n As Long '行番号STEP
Dim s As Long 'START
Dim e As Long '各End
Sheets("Sheet1").Select
　 　 　s = 1
　 　 　With Sheets("Sheet2")
　 　 　For n = 2 To 256 Step 2
　 　 　 　 　 　e = Cells(65536, n).End(xlUp).Row
　 　 　 　 　 　If Cells(e, n) = "" Then Exit For
　 　 　 　 　 　.Range(.Cells(s, 1), .Cells(s + e - 1, 1)) = Cells(1, n - 1).Value
　 　 　 　 　 　.Range(.Cells(s, 2), .Cells(s + e - 1, 2)) = _
　 　 　 　 　 　 Range(Cells(1, n), Cells(e, n)).Value
　 　 　 　 　 　 s = s + e
　 　 　Next n
　 　 　End With
End Sub

回答No.4

某HN クロメート(Chromate)（@CoalTar）

作業行を使えば何とか関数で
A9セル 0
B9セル 各々の個数を累計する
=IF(COUNT($A$9:A9)>COLUMNS($A$1:$H$8)/2,"",A9+COUNTA(INDEX($A$1:$H$8,,COLUMN(A1)*2)))
右へオートフィル

A11セル
=A1 右へオートフィル

A12セル
=IF(COUNTA(A$11:A11)>=MAX($A$9:$H$9),"",INDEX($A$1:$G$1,MATCH(COUNTA(A$11:A11),$A$9:$E$9)*2-1))
B12セル
=IF(A12="","",INDEX($B$1:$H$8,COUNTIF(A$11:A12,A12),MATCH(A12,$A$1:$G$1,0)))
A12:B12セル 下へオートフィル

A1,C1,E1・・・重複なきこと

お礼

できました！

以外と簡単な関数でできるのですね。
あまり使いこなせていないので思いつきませんでした。
ありがとうございます。

回答No.3

keithin

おや，申し訳ないです，誤記てました。

変更前：
for i = 2 to range("IV1").end(xltoleft).column step 2

変更後：
for i = 2 to w.range("IV1").end(xltoleft).column step 2

失礼しました。

＃手元で試した具合では，たまたま回答１，２ともにAB列だけしかコピーされませんでしたが，アナタのお手元で上手く行ってると言うことは，あなたの実際のエクセルはご相談で情報提供されたのとはどこかが違うのかもしれませんね？

お礼

修正ありがとうございます。

できました！
もうひとりの方との書き方の違いなんかも参考にさせていただきます。

AB列のみのコピーというのがちょっと分からないのですが、
結果は大変満足のゆくものとなっております。
ありがとうございました。

回答No.1

keithin

関数でもやってできなくはありませんが，マクロを使った方が遙かに簡単です。

手順：
ALT+F11を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim w as worksheet
　dim i as long
　dim n as long

’準備
　set w = activesheet
　worksheets.add after:=activesheet
　range("A1:B1") = array("Gr","Code")

’順に転記
　for i = 2 to range("IV1").end(xltoleft).column step 2
　　n = w.cells(65536, i).end(xlup).row
　　w.cells(1, i).resize(n, 1).copy destination:=range("B65536").end(xlup).offset(1)
　　range("A65536").end(xlup).offset(1).resize(n, 1) = w.cells(1, i-1).value
　next i
end sub

ファイルメニューから終了してエクセルに戻る
元データのシートを開く
ALT+F8を押し，現れたダイアログで今登録したMacro1を実行する

お礼

早速のご回答ありがとうございます。

やってみたのですが、形式は思い通りになりました！
ただ、ひとつめのグループのみの出力となってしましました。
一度にすべてのグループができたら更にありがたいです。

しかし、いただいたプログラムを元に、勉強させていただきます！
ご回答、ありがとうございました。