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

解決済みの質問

エクセルVBA(rangeでの複数範囲指定方法)

いつも有難うございます。
タイトルの件でご教示いただきたく、お願いいたします。

やりたいことは、複数のセル結合を一括でおこないたい、というものです。

具体的には【A列をn行目まで、2行ずつセル結合する】方法です。

例えば、20行目まで2行ずつ結合する、と決まっていれば次のような記述が可能です。
(例1)
Range( _
"A1:A2,A3:A4,A5:A6,A7:A8,A9:A10,A11:A12,A13:A14,A15:A16,A17:A18,A19:A20"). _
MergeCells = True

これを「n行目」までとするため、次のような記述を考えました。
(例2)
  Dim i As Integer
  Dim n As Integer

Range("A65536").End(xlUp).Select
n = ActiveCell.Row + 1

For i = 1 To n Step 2
Range(Cells(i, 1), Cells(i + 1, 1)).MergeCells = True
Next

こちらの For ~ Next 内の構文についてです。
この構文ですと、一つずつ選択→結合をしていくので、相応の時間がかかってしまうため、
例1の構文のように、先に範囲を指定して一括で結合する方法を調べたのですが見つからず
質問させていただきました。

(やりたい構文)
For i = 1 To n Step 2
  ※ = (A1:A2,A3:A4,・・・An-1:An)
Next
  Range(※).MergeCells = True

このような方法はありますでしょうか。
ご教示のほど、宜しくお願いいたします。

投稿日時 - 2014-03-25 14:32:27

QNo.8528240

困ってます

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

http://veaba.keemoosoft.com/2013/02/494/

これとか参考にどうでしょうか?

投稿日時 - 2014-03-25 14:46:14

お礼

皆様、いろいろとお知恵をくださり有難うございました。
それぞれ試してみたところ、甲乙付けがたかったのですが、
こちらが一番しっくりきたのとリンク先のページが
その他の情報の参考にもなるので、ベストアンサーに
選ばせていただきました。
今後とも宜しくお願いいたします。

投稿日時 - 2014-03-25 16:42:08

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

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

回答(4)

ANo.4

こんにちは!
一例です。

A列の65536行目までを2行ずつ結合するとして・・・
倍々でコピーしていってはどうでしょうか?
まずA1・A2セルを結合 → A3セルにコピー&ペースト → A1~A4セルをA5セルに
A1~A8セルをA9セルに → A1~A13をA17セルに・・・
といった感じです。
最初はあまり速くない感じですがコピー&ペーストの範囲がだんだん広くなっていきます。
最終的にはこれを15回繰り返せば65536行まで達すると思います。

Sub Sample1()
Dim cnt As Long
Range("A1:A2").Merge
Do Until cnt = 15
cnt = cnt + 1
Range(Cells(1, "A"), Cells(2 ^ cnt, "A")).Copy Cells(2 ^ cnt + 1, "A")
Loop
MsgBox "処理完了"
End Sub

尚、お示しのコードはA65536セルから上に向かって最終データ行を取得し、結合したいものと思われますが、
すべて同じデータであれば問題ないかもしれませんけど、データが違う場合は結合できないと思いますので
インプットボックスに結合したい最終行(かならず偶数行)を入力し
A1~入力したセルまでを二つずつ結合させるコードも載せてみます。
(単にオートフィルでの処理です)

Sub Sample2()
Dim lastRow As Long
lastRow = InputBox("結合したい最終行を偶数で入力")
Range("A1:A2").Merge
Range("A1").Select
Selection.AutoFill Destination:=Range(Cells(1, "A"), Cells(lastRow, "A")), Type:=xlFillDefault
End Sub

こんな感じではどうでしょうか?m(_ _)m

投稿日時 - 2014-03-25 16:19:56

for ~lnext、Do~Loop両方やってみました。
10000行処理で両方共に約1秒の処理時間でした。
B1セルに処理時間表示するようにしてあります。

確認後はタイマーの不要部分は削除下さい。

処理速度はor ~lnextよりDo~Loopの方が早いとネットで出てましたが、演算でないのであまり変わらないようです。
selectやactive、copy等は処理速度が遅くなるはずですので、使用は出来るだけ避けたほうが良いようです。

Application.ScreenUpdating = Falseで画面更新を中断させました。これで私のPCで約0.5秒早く処理出来ました。

ご参考まで



Sub sample1()
Dim i, n As Long
Dim dblStart As Double '開始時刻取得エリア
Dim dblEnd As Double '終了時刻取得エリア
Dim lngCnt As Long 'カウンタ
Dim dblTime As Double '所要時間取得エリア


dblStart = Timer

'最終行が奇数行の場合は1を足し偶数行にする。
n = Cells(Rows.Count, 1).End(xlUp).Row
If n Mod 2 = 1 Then n = n + 1

Application.ScreenUpdating = False

For i = 1 To n Step 2

Range(Cells(i, 1), Cells(i + 1, 1)).MergeCells = True

Next

'終了時刻を取得する
dblEnd = Timer

'所要時間を計算する
dblTime = dblEnd - dblStart

' 所要時間を表示します。
Cells(1, 2) = "所要時間は" & Format$(Int(dblTime * 10 ^ 4 + 0.5) / 10 ^ 4) & "秒だよ。"

Application.ScreenUpdating = True

End Sub


Sub sample2()
Dim i, n As Long
Dim dblStart As Double '開始時刻取得エリア
Dim dblEnd As Double '終了時刻取得エリア
Dim lngCnt As Long 'カウンタ
Dim dblTime As Double '所要時間取得エリア


dblStart = Timer

n = Cells(Rows.Count, 1).End(xlUp).Row
If n Mod 2 = 1 Then n = n + 1

i = 1

Application.ScreenUpdating = False

Do While i < n

Range(Cells(i, 1), Cells(i + 1, 1)).MergeCells = True
i = i + 2

Loop

'終了時刻を取得する
dblEnd = Timer

'所要時間を計算する
dblTime = dblEnd - dblStart

' 所要時間を表示します。
Cells(1, 2) = "所要時間は" & Format$(Int(dblTime * 10 ^ 4 + 0.5) / 10 ^ 4) & "秒だよ。"

Application.ScreenUpdating = True
End Sub

投稿日時 - 2014-03-25 15:40:42

ANo.2

Range("A65536").End(xlUp).Select
n = Int((ActiveCell.Row + 1) / 2) * 2
Range("a1:a2").Select
Selection.Merge
Selection.Copy
Range(Cells(3, 1), Cells(n, 1)).Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

「結合は書式だから、書式のコピーをすれば良い」ってのに気が付けるかどうか。

あと「2行分をコピーしているから、コピー先のセルの範囲指定は必ず2の倍数の行数にしないといけない」ので、nの計算にちょっと調整が入ってます。

あと「セルのコピー」なので、数万行あれば「それなりの時間」がかかります。

投稿日時 - 2014-03-25 15:16:15

あなたにオススメの質問