こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセル マクロでセルを自動移動

例1のようになっているエクセル表があります。
データは右方向、下方向へ増えます。
Cの列以降は4つ単位でしかデータは増えません。
それを例2の表のように列A,Bのデータはそのままに
Cの列以降の4つのセルを区切りに下の行に移動して、
空白の列まで言ったらA2の行以降を最後の行まで繰り返しするという
マクロを書くことは可能でしょうか。
出来ましたらそのマクロを教えてください。

例1
A1 B1 C1 D1 E1 F1 G1 H1 I1 J1 K1 L1 M1 N1
A2 B2 C2 D2 E2 F2 G2 H2 I2 J2
A3 B3 C3 D3 E3 F3 G3 H3 I3 J3 K3 L3 M3 N3


例2
A1 B1 C1 D1 E1 F1
A1 B1 G1 H1 I1 J1
A1 B1 K1 L1 M1 N1
A2 B2 C2 D2 E2 F2
A2 B2 G2 H2 I2 J2
A3 B3 C3 D3 E3 F3
A3 B3 G3 H3 I3 J3
A3 B3 K3 L3 M3 N3

投稿日時 - 2009-07-17 18:18:56

QNo.5133345

困ってます

質問者が選んだベストアンサー

なかなか回答がつかないようなので、とりあえず。

[移動]よりも[転記]の方が簡単ですし、高速です。

Sheet1のA1セル以下に元データがあり、
Sheet2のA1セル以下に転記する場合だとこんな感じかと。

'================↓ ココカラ ↓================
Sub Sample()
 Dim orSht As Worksheet
 Dim rtSht As Worksheet
 Dim i As Long '元範囲行カウンタ
 Dim j As Long '元範囲列カウンタ
 Dim k As Long '先範囲行カウンタ
 Set orSht = Worksheets("Sheet1") '元シート
 Set rtSht = Worksheets("Sheet2") '先シート
 i = 1 '元範囲先頭行
 k = 1 '先範囲先頭行
 Do Until orSht.Cells(i, 1) = ""
  j = 3
  Do Until orSht.Cells(i, j) = ""
   rtSht.Cells(k, 1).Resize(, 2).Value _
    = orSht.Cells(i, 1).Resize(, 2).Value
   rtSht.Cells(k, 3).Resize(, 4).Value _
    = orSht.Cells(i, j).Resize(, 4).Value
   j = j + 4
   k = k + 1
  Loop
  i = i + 1
 Loop
End Sub
'================↑ ココマデ ↑================

Excel2003で動作確認。以上ご参考まで。

投稿日時 - 2009-07-17 21:20:58

お礼

Excel2002でしたが正常に動作しました。
大変助かりました。有り難うございます。

投稿日時 - 2009-07-18 12:57:37

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

コードを書いてくださいという質問(と言うより依頼)はこのコーナーの規約違反です。
こんな程度のことまで、丸投げするのは不勉強です。
ーー
dにデータ最終行を求める。
For i=1 to d
rにi行の最右端列を求める
for j=3 r step 4
別にデータを持っていくシートの方の行カウンタをkとする
A,B列をA,B列に。その後の4行をC-F列へ
K=K+1
jの繰り返し
iの繰り返し。
このロジックをまず抑えること。
==
Sub test01()
Dim sh1, sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
MsgBox d
k = 1
For i = 1 To d
r = sh1.Range("IV" & i).End(xlToLeft).Column
MsgBox r
For j = 3 To r Step 4
sh2.Cells(k, "A") = sh1.Cells(i, "A")
sh2.Cells(k, "B") = sh1.Cells(i, "B")
sh1.Activate
sh1.Range(Cells(i, j), Cells(i, j + 3)).Copy sh2.Cells(k, 3)
k = k + 1
Next j
Next i
End Sub
ーーー
全体的な構想を組み立てると言うことのほかに
この中で初心者に難しい点は
シートを2つ処理対象にする方法
最下行行番号を求める方法
最右列列番号を求める方法
コピー貼り付けを1行で済ます方法
データアウトプットのシートの記入位置を示す行ポインタのkの使い方
などかな。これらを出来なければVBAで何も出来ない状態のはず。

投稿日時 - 2009-07-17 21:20:47

お礼

規約違反とは知らず書き込んでしまい、すみませんでした。
そんな私にご丁寧に回答頂き有り難うございます。

投稿日時 - 2009-07-18 12:59:05

あなたにオススメの質問