(VBAにて)列のセルの結合について

VBAを使って列の結合を行うとしています。
内容は
・A3とA4を結合～A59とA60を結合(60まで)
　という具合に、セル2つで一つの組み合わせです。
・これが列単位にA列～Y列まで同じように行おうとしています。
・一つ一つマクロで記述するとえらい手間がかかるので
　簡略するマクロ文は無いでしょうか？
・また、この作業はsheet3で行おうとしています。
　内容はsheet1に書かれていまして、
　(A4～Y4までが1レコードでA20～Y20まであります。)
　マクロで普通にsheet3にコピーをすると1レコード目の後に
　2レコード目が飛んで3レコード目が次にきてしまいます。
・これはどうすればよいでしょうか？

素人であまりよく分かりません
ご教授宜しくお願いします。
　　

No.2 ベストアンサー 回答者： qualheart 回答日時： 2007/10/10 10:09

Sub Macro1()

name1 = Worksheets(1).Name
name3 = Worksheets(3).Name
Worksheets(3).Activate
n = 4
For r = 3 To 59 Step 2
For c = 1 To 25
Worksheets(name3).Range(Cells(r, c), Cells(r + 1, c)).Merge
Worksheets(name3).Cells(r, c).Value = Worksheets(name1).Cells(n, c)
Next
n = n + 1
Next

End Sub


ですね。

この回答へのお礼

返信ありがとうございました。
参考にさせて頂きました。
感謝しております。

お礼日時：2007/10/13 10:21

No.3 回答者： imogasi 回答日時： 2007/10/10 10:36

質問の表現をはっきりさせること。

私なら下記にする。
ーー
●Sheet1-->Sheet3へコピー、Sheet3でセル結合する。
言いたいことはSheet1からSheet3へデータを写すということであって
、コピー操作ではないのでは？紛らわしい。
●範囲はA3:Y60（＞A20～Y20まであります、と矛盾しない？）
●セル結合は、３行目と４行目、５と６・・のようにおこなう。
●A4とA5には、それぞれデータが入っているのか？
文字列は結合もできるが、数字セルはどうするのか？
あるいはSheet1の結合前の１行データを、セル結合後のSheet3の行に入れていくのか。
●行数を２倍にするの。普通には意味がないと思うが？行幅を広げればすむのでは？
こういうのはC列８行ぐらいで質問して、回答を質問者側でY列、６０行？まで広げればよい。
ーー
補足要求の返事もない場合が多いので、独断でやってみる。
例データ
Sheet1　A3:C11
a1234
b23123
c3445
d45678
e12432
f2345
g4112
h7334
コード
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet3")
'---
For j = 1 To 3 'C列までの例
For i = 3 To 8 * 2 + 2 Step 2 '8行の例
sh2.Range(sh2.Cells(i, j), sh2.Cells(i + 1, j)).MergeCells = True
k = Int((i - 1) / 2) + 2
sh2.Cells(i, j) = sh1.Cells(k, j)
Next i
Next j
End Sub
ーー
結果
Sheet3　A3:１８
a1234

b23123

c3445

d45678

e12432

f2345

g4112

h7334

ーー
＞素人であまりよく・・
質問文章の課題の説明が、あいまいと思った。VBAが判ってくると
明確に表現できるようになるもの。
マクロの記録で済むものとは随分考え方が違っているので、質問者には、荷が重いと思う。

この回答へのお礼

返信ありがとうございました。
皆さんのを参考に何とか出来ました。
ありがとうございました。

お礼日時：2007/10/13 10:22

No.1 回答者： n-jun 回答日時： 2007/10/10 09:52

Sub　Test()

　Dim　i　As　Long
　Dim　j　As　Long
　Application.ScreenUpdating　=　False
　With　Worksheets("Sheet3")
　　　　　　For　i　=　1　To　25
　　　　　　　　　　For　j　=　3　To　59　Step　2
　　　　　　　　　　　　　　.Range(.Cells(j,　i),　.Cells(j　+　1,　i)).Merge
　　　　　　　　　　Next
　　　　　　Next
　　i　=　3
　　　　　　For　j　=　4　To　20
　　　　　　　　　　.Cells(i,　1).Resize(,　25).Value　=　_
　　　　　　　　　　Worksheets("Sheet1").Range("A"　&　j).Resize(,　25).Value
　　　　　　　　　　i　=　i　+　2
　　　　　　Next
　End　With
　Application.ScreenUpdating　=　True
End　Sub
こんな感じの事でしょうか？
ファイルをコピーしてから試してみて下さい。

この回答へのお礼

返信ありがとうございました。
非常に参考になりました。
感謝しております。

お礼日時：2007/10/13 10:20