複数セルをまとめて移動させるマクロ

質問

こんにちは。どうぞよろしくお願いいたします。

Excel2003で、1行に3セルで構成されるデータが3データ記述してあるのを、
1行に1データ分として2データ目以降を次の行に移動させ、9列→3列に変更するマクロを作成したいと考えています。

【現在のデータ】
　　A　　　　B　　　　C　　　　D　　　　E　　　　F　　　　G　　　　H　　　　I
1　氏名1　住所1　電話1　氏名2　住所2　電話2　氏名3　住所3　電話3
2　氏名4　住所4　電話4　氏名5　住所5　電話5　氏名6　住所6　電話6
:

【計算結果】
　 A　　　　B　 　　C
1　氏名1　住所1　電話1　
2 氏名2　住所2　電話2　
3 氏名3　住所3　電話3
4　氏名4　住所4　電話4　
5 氏名5　住所5　電話5　
6 氏名6　住所6　電話6
:

この操作を繰り返すマクロを作成したいと思っています。
マクロは初心者ですので、繰り返して実行するロジックがよくわかりません。
すみませんが、どうぞご指導よろしくお願いいたします。

回答No.4

ereserve67

ANo.2です．

少し改良：9列から3の倍数の列に対応しコード量を減らしました．

基本的方針は

・現在データシート行毎の下記ルーティーンで行末までDo Loop（何行あってもよい）
・現在データシートの各行の3列セットを左から右までFor Nextで結果シートの3列に上から下へ転記
(3列が何セットあってもよい)
・3列を○列に帰る時は☆の部分を改良する．

Sub macro()

Dim i As Integer, n As Integer
Dim c1 As Range
Dim c2 As Range

Set c1 = Worksheets("Sheet1").Range("A1")'現在データシートの先頭
Set c2 = Worksheets("Sheet2").Range("A1")'結果シートの先頭
n = c1.End(xlToRight).Column / 3 '３列セットがいくつあるかを取得☆

Do Until c1 = ""
For i = 1 To n
c2 = c1.Offset(0, (i - 1) * 3)'1列転記☆
c2.Offset(0, 1) = c1.Offset(0, (i - 1) * 3 + 1)'2列転記☆
c2.Offset(0, 2) = c1.Offset(0, (i - 1) * 3 + 2)'3列転記☆
Set c2 = c2.Offset(1)'結果シートの次の行へ
Next i
Set c1 = c1.Offset(1)'現在データシートの次の行へ
Loop

End Sub

後はエラー処理など実用的に改良してみて下さい．

回答No.3

K Kazz（@JazzCorp）

関数で、、、
Sheet1からSheet2に変換して出力
先頭１行はヘッダ
Sheet2の、
Ａ２：
=OFFSET(Sheet1!$A$2,INT(ROW()+1)/3-1,COLUMN()-1+MOD((ROW()-2)*3,9))
右の、Ｂ～Ｃ列にコピー
以下、Ａ～Ｃ列まとめてコピー

お礼

マクロを組む程でもないデータ量だと役に立ちますね。
大変参考になりました。ありがとうございました！

回答No.2

ereserve67

以下でどうでしょう．

Sub macro()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim c1 As Range
Dim c2 As Range

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

Set c1 = ws1.Range("A1")
Set c2 = ws2.Range("A1")

Do Until c1 = ""
c2 = c1
c2.Offset(0, 1) = c1.Offset(0, 1)
c2.Offset(0, 2) = c1.Offset(0, 2)
Set c2 = c2.Offset(1)
c2 = c1.Offset(0, 3)
c2.Offset(0, 1) = c1.Offset(0, 4)
c2.Offset(0, 2) = c1.Offset(0, 5)
Set c2 = c2.Offset(1)
c2 = c1.Offset(0, 6)
c2.Offset(0, 1) = c1.Offset(0, 7)
c2.Offset(0, 2) = c1.Offset(0, 8)
Set c1 = c1.Offset(1)
Set c2 = c2.Offset(1)
Loop
End Sub

お礼

大変参考になりました。ありがとうございました！

回答No.1

keithin

繰り返すだけなら、for to nextとかfor each nextでぐりぐりやるだけですが、重要なのは「一体何を繰り返し作業するのか」です。

作成例：
sub macro1()
　dim r as long
　dim c as long

　for r = range("A65536").end(xlup).row to 1 step -1
　　for c = 7 to 4 step -3
　　’切り取り＆挿入を繰り返す
　　　cells(r, c).resize(1, 3).cut
　　　cells(r + 1, "A").entirerow.insert
　　next c
　next r
end sub

お礼

大変参考になりました。ありがとうございました！