エクセルのデータ入れ替え

質問

エクセルに
1氏名
2電話番号
3住所
4氏名
5電話番号
6住所

と入力されたデータがあります。
これを、
Ａ氏名　Ｂ電話番号　Ｃ住所
　氏名　　電話番号　　住所

と変換させたいのですが、どうしたら簡単に手っ取り早く
変換出来るでしょうか？
かなりの数があるので、手間の掛からない方法を教えて下さい。
また、これを使って印刷をするので、それを考慮した方法で
お願いします。

回答No.5

imogasi

普通は関数でやるが、
VBAでやると
Sub test01()
Dim sh1, sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = Range("A65536").End(xlUp).Row
'--
For j = 1 To 3
For i = j To d Step 3
sh2.Cells(Int((i - 1) / 3) + 1, j) = sh1.Cells(i, "A")
Next i
Next j

End Sub
VBAでも色々な処理ロジックが考えられるという例。

回答No.4

normo

ものすごいローテクで、こんなのどうですか？

まず、隣の列にa,b,cを入力し下にコピーする。（a,b,c,a,b,c,a,b,c・・・）
a,b,cじゃなくてもなんでもいいですけど、例えばです。
↓こんな感じ

a 氏名
b 電話番号
c 住所
a 氏名
b 電話番号
c 住所

オートフィルタを使い'a'の行み表示させてコピーし、別のシートのA列に貼り付ける。これで氏名の列が完成です。
b,cについても同様に。

回答No.3

mu2011

別シートに並び替える方法ですが如何でしょうか。
元シートをシート１として、シート２の任意セルに次の数式を設定し、縦横にコピーして下さい。
=OFFSET(Sheet1!$A$1,ROW(A1)-1+(ROW(A1)-1)*2+(COLUMN(A1)-1),0)

回答No.2

irija_bari

マクロ（VBA）を使用することになると思います。

・Sheet1 を変換して Sheet2 へコピーするものとします。
・Sheet1 は必ず 1 行目から開始する。
・1 人分で 3 行使用する。
・途中に空の行が無いものとする。

という条件の下で実行します。この条件を満たさない場合は、条件を満た
すように Sheet1 を手直しする、または、VBA コードを書き換えるという
作業が必要になります。

Sheet2 を開いて、「ツール」->「マクロ」->「Visual Basic Editor」を
選択し、開いた VBE に以下のコードを貼り付けます。

あとは、「ツール」->「マクロ」->「マクロ」で貼り付けたマクロが表示
されますので、それを実行します。
詳しくコメントを書きました（つもり）ので、これを機に VBA を少し勉強
してみてはいかがでしょうか。

>また、これを使って印刷をするので、それを考慮した方法で
>お願いします。

なにを考慮すれば良いのかわからないので、対応できません。

==== コード ====
Sub test()
　　'Sheet1 の 1 行目から実行
　　intRow1 = 1
　　'Sheet2 の 1 行目からコピーする
　　intRow2 = 1
　　'Sheet1 の 1 列 intRow1 行目のセルが空でなければ...
　　While Worksheets("Sheet1").Cells(intRow1, 1) <> ""
　　　　'3 行分コピーする
　　　　For i = 0 To 2
　　　　　　'Sheet1 の 1 列 intRow1 + i 行目のセルの値を Sheet2 の i + 1 列 intRow2 行目のセルにコピーする
　　　　　　Worksheets("Sheet2").Cells(intRow2, i + 1) = Worksheets("Sheet1").Cells(intRow1 + i, 1)
　　　　Next
　　　　'Sheet1 の行番号を +3 する
　　　　intRow1 = intRow1 + 3
　　　　'Sheet2 の行番号を +1 する
　　　　intRow2 = intRow2 + 1
　　Wend
End Sub
==== コード ここまで ====

回答No.1

S-Fuji

マクロは如何でしょう。
Sub test1()
Dim i As Integer, k As Integer
k = 1
For i = 2 To 4 '人数分＋１
Cells(i, 2) = Cells(k, 1)
Cells(i, 3) = Cells(k + 1, 1)
Cells(i, 4) = Cells(k + 2, 1)
k = k + 3
Next i
End Sub
－－－－－－－
For文の４の所を人数分＋１にして（例は３人分）
変換の確認をしたら、A列を削除すればOK