• ベストアンサー
  • 困ってます

エクセル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 このような方法はありますでしょうか。 ご教示のほど、宜しくお願いいたします。

共感・応援の気持ちを伝えよう!

  • 回答数4
  • 閲覧数676
  • ありがとう数14

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

  • ベストアンサー
  • 回答No.1

http://veaba.keemoosoft.com/2013/02/494/ これとか参考にどうでしょうか?

共感・感謝の気持ちを伝えよう!

質問者からのお礼

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

関連するQ&A

  • エクセルVBAでRangeの引数制限?

    エクセル2000です。 Sub test() Range("A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34,A35,A36,A37,A38,A39,A40,A41,A42,A43,A44,A45,A46,A47,A48,A49,A50,A51,A52,A53,A54,A55,A56,A57,A58,A59,A60,A61,A62,A63,A64,A65,A66,A67,").Select End Sub 上記の67個のセルを選択するマクロを実行すると 「実行時エラー1004 Rangeメソッドは失敗しました。'Global'オブジェクト」となってしまいます。 一個へらして66個にすると問題なく選択されます。 Rangeに個別で記載できる引数は66個までなのでしょうか? 質問に書いたセルは、数が一目でわかるための例なので、Range("A1:A67").Selectという回答以外でお願いします。

  • エクセルVBA カウンタ2つを入れ子にしたくない時

    皆さんこんにちは。 エクセル2013を使用しております。 エクセルVBAの繰り返し処理について質問させていただきます。 下記のコードですと入れ子があるので A1にi、A3にi・・・・を一通り記載したあと またA1にi+2、A3にi+2・・・を繰り返し 最終的にA列には全て同じ値が入ってしまいます。 (Step 2にしたのはA1:A2のように2行毎の結合セルだからです) -----------------------------------------------------------------    Dim i As Long Dim j As long Dim n As long Dim k As long     i =Userform.textbox1.value     j =Userform.textbox2.value    For k =i To j Step 2 For n = 1 to j Step 2 Range("A" & n) = k    Range(”B”&n)=k+1        Next    Next ---------------------------------------------------------- もしiが1、jが10だとしたら A1に1、B1に2、A3に3、B3に4、・・・A9に9、B9に10 が入るようにするにはどうしたら良いでしょうか。 iが必ず1から始まるのであればまだ分かるのですが そうとも限らないので カウンタはやはり2つ必要だと思うのですが カウンタが2つあるのに入れ子にしないコードの書き方って あるのでしょうか。 いくら本やネットを見ても分かりません。 ご教授いただけると幸いです。

  • EXCEL VBA----離れたセル範囲の指定

    こんにちは。初歩的なことで困っています。 Range("A3:A19,F3:F19").Select のように、離れたセル範囲を選択したいのですが 上の例の19行目が不定であるため、変数を使ったCellsプロパティを使用し i=Range("A3").End(xldown).Row Range("Cells(3, 1).Cells(i, 1), Cells(3, 6).Cells(i, 6)").Select と書いてみたのですが、エラーになってしまいました。 正しい指定の仕方を教えて下さい。よろしくお願いします。

その他の回答 (3)

  • 回答No.4
  • tom04
  • ベストアンサー率49% (2537/5117)

こんにちは! 一例です。 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

共感・感謝の気持ちを伝えよう!

  • 回答No.3
noname#203218

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

共感・感謝の気持ちを伝えよう!

  • 回答No.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の計算にちょっと調整が入ってます。 あと「セルのコピー」なので、数万行あれば「それなりの時間」がかかります。

共感・感謝の気持ちを伝えよう!

関連するQ&A

  • excelのソルバーをVBAで複数行繰り返したい

    目的セル  A1 変化させるセル  B1:E1 から始めて、A2,B2:E2、A3,B3:E3・・・ というように行を一列ずつずらして繰り返したいと思いプログラミングの知識とか全然ないんですが、あちこち調べて、 Sub Macro1() Dim x As Integer For x = 1 To 5 SolverOk SetCell:="Cells(x,1)", MaxMinVal:=3, ValueOf:="1", ByChange:="Range(Cells(x,2),Cells(x,5))" SolverSolve Userfinish:=True  Next x End Sub というところまで作ってみたんですが、実行してみると一行目は変わるもののそれ以降が変化しません。 理由がまったくわからないんですが、どなたかおかしなところがわかる方お教えくださいm(__)mm(__)m

  • Excel マクロ:変数を複数使う場合

    マクロ初心者です。 For文で、変数を2つ定義し、それぞれが1つずつ増えてくれるような マクロを組みたいのですが、うまくいきません。 例えばA列の並んだ数字を、B列に一個とばしで入力するとして・・・ 例) Dim i As Integer Dim j As Integer For j = 2 To 10 Step 2 For i = 1 To 9 Cells(j, 2).Value = Cells(i, 1).Value Next i, j ではだめですよね。iが1つ増える時に、jも1つ増える、 というようにVBAを組むことが可能なのでしょうか? ど素人な質問ですみませんが、教えてください。

  • エクセルのマクロで複数セル指定は?

    以前(7月22日 質問No.936181)の質問でご回答を頂いたマクロなんですが、 Private Sub Worksheet_Change(ByVal Target As Range) Dim MyData As String Dim i As Integer Dim ImaNanji As String Dim SakkiNanji As String Dim ImaNanpun As String Dim SakkiNanpun As String SakkiNanpun = Cells(2, 3).Value ImaNanji = Cells(1, 3).Value ImaNanpun = Mid(ImaNanji, Len(ImaNanji) - 4, 2) If ImaNanpun <> SakkiNanpun Then Application.EnableEvents = False For i = 10 To 2 Step -1 MyData = Cells(i - 1, 2).Value Cells(i, 2).Value = MyData Next i MyData = Cells(1, 1).Value Cells(1, 2).Value = MyData Cells(2, 3).Value = ImaNanpun Application.EnableEvents = True End If End Sub A1のデータをB1からB10に一分おきにつぎつぎに書き込むというものなんですが、ひとつのセルではなく複数のセル(例えばA1からA30の30個のセル)をいっぺんに書き込むようにしたいのですが可能でしょうか? よろしくお願いします。

  • データ検索ネスト Excel VBA

    excel2003でデータ検索の処理をするというマクロをVBAで作成したいのですが、うまく動作しません。自作のVBAを記載してみましたので何が原因なのか教えてください。初心者です、よろしくお願いします。 Sub データ検索() Dim i As Integer, j As Integer, k As Integer, l As Integer Dim myRange As Range Dim IngLastrow As Long IngLastrow = Range("A65536").End(xlUp).Row For i = 3 To IngLastrow For j = 3 To 25 For k = 8 To 53 For l = 3 To 9 Set myRange = Worksheets("データベース").Cells(i, "o").Find(what:=Worksheets("コード").Cells(j, "o").Value, _ LookIn:=xlValues) If Not myRange Is Nothing Then Worksheets("予定").Cells(k, l).Value = myRange.Offset(, -12).Value End If Next l Next k Next j Next i End Sub

  • エクセルでくんだVBAマクロが途中でとまるのですが、

    エクセルでくんだVBAマクロが途中でとまるのですが、 どこがおかしいかご指摘して頂けませんでしょうか? 以下のプログラムは セル(19.6)にxの値を代入し、 E24にそれに対応したyを出力させるプログラムです。 あと余談となりますが、 繰り返し構文は同時に複数の変数はできないのでしょうか? 例えば以下のものは変数iをステップ0.1で加算していますが それに対応して表示させるセルを一つずつずらすために 変数kを指定してfor構文を連立させようとしたのですが うまくいきませんでした。 Sub k() Dim i As Double For i = 0 To 10 Step 0.1 Cells(22 + 10 * i, 7).Value = i Cells(19, 6).Value = i Range("H" & 10 * i + 22).Value = Range("E24").Value Next i End Sub

  • エクセルVBAでTransposeの不思議

    MS Officeのエクセル2000です。 下記Sub test01はRange("A1:I1")に文字列を入力し、一旦配列に取り込んでからワークシートに貼り付けるものです。 試験用のコードですので意味はありません。 このコードで255文字まではまったく問題はありません。 ところが、256文字以上の場合、横に貼り付けは問題ないのですが、 Transposeで縦に変換すると型が一致しません。(Error 13)となります。 どうしてでしょうか? 試行錯誤の結果、Sub test02のように一旦横に貼ったデータをコピーしてTransposeして貼り付けるのは大丈夫のようですので不思議でしょがありません。 またこの方法は列数256より要素が多い配列には使えないので解決策にはなりません。 ご教示くださいませ。 Sub test01() Dim myAr As Variant Dim i As Integer, n As Integer n = 256 '文字数 With ActiveSheet .UsedRange.ClearContents For i = 1 To 9 .Cells(1, i).Value = Application.Rept(Left(.Cells(1, i).Address(0, 0), 1), n) Next myAr = .Range("A1:I1").Value .Range("A3").Resize(, UBound(myAr, 2)).Value = myAr .Range("A5").Resize(UBound(myAr, 2)).Value = Application.Transpose(myAr) '256文字の場合エラー End With End Sub Sub test02() Dim myAr As Variant Dim i As Integer, n As Integer n = 256 '文字数 With ActiveSheet .UsedRange.ClearContents For i = 1 To 9 .Cells(1, i).Value = Application.Rept(Left(.Cells(1, i).Address(0, 0), 1), n) Next myAr = .Range("A1:I1").Value .Range("A3").Resize(, UBound(myAr, 2)).Value = myAr .Range("A3").Resize(, UBound(myAr, 2)).Copy .Range("A5").PasteSpecial Paste:=xlValues, Transpose:=True '256文字の場合もOK Application.CutCopyMode = False End With End Sub

  • VBA Range・Cellsプロパティについて

    下記のコードについて質問致します。 Sub 特定のセルをコピー() Dim rw2 As Long Dim rw1 As Long Dim newdate As Date With Worksheets("steet1") rw2 = .cells(.Rows.Count, "c").End(xlUp).Row newdate = .Range("c" & rw2).value For rw1 = rw2 - 1 To 1 Step -1 If .Range("c" & rw1).value <> newdate Then Exit For Next rw1 .Range(.cells(rw1 + 1, 1), .cells(rw2, 1)).Copy     '(1) Worksheets("steet2").Range("v6").PasteSpecial xlValue End With End Sub (1)部分のコードの意味が分かりません。 よろしくお願いします。

  • エクセル VBA もっときれいな書き方?

    Sub test() Dim i As Integer, n As Integer n = 1 For i = 2 To 150 If Cells(i, 1) <> Cells(i - 1, 1) Then Cells(i - 1, 5) = i - n Cells(i - 1, 6) = Application.WorksheetFunction.Sum(Range("B" & n & ":" & "B" & i - 1)) n = i End If Next i End Sub 上記のマクロですが Application.WorksheetFunction.Sum(Range("B" & n & ":" & "B" & i - 1)) この部分、もっとスマートに書く方法を教えてください。 Range("B" & n & ":" & "B" & i - 1)って、ちゃんと動きますが、書き方が何か変なような気がするんです。 よくわかってもいないのにすみません。

  • エクセル関数をVBAで表示する。

    よろしくお願いします。 =IF(F5<>"",A4+1,0) =IF(F7<>"",MAX($A$4:A6)+1,0) =IF(F9<>"",MAX($A$4:A8)+1,0) 以下 =IF(F231<>"",MAX($A$4:A230)+1,0) まで この関数をVBAで表示する方法がわかりません。 お教えください。 Dim i As Long Range("A5")="=IF(F5<>"""",A4+1,0)" Range("A5:A232").ClearContents For i = 7 To 232 Step 2 Cells(i, "A").Value = "=IF(F7<>"""",MAX($A$4:i+1)+1,0)" Next

  • VBAで行列を作る方法

    次のようなプログラミングで1,0,&#65293;1の要素で作られる3×3行列を全通り調べています。 この場合3の9乗通り調べることができます。 これを4×4や5×5行列など数を大きくして調べたいのですが、このプログラムを配列を使うなどして 簡単にできる方法を教えてください。 よろしくおねがいします。 Sub test() Dim a As Integer '行 Dim b As Integer '列 Dim c As Integer, i As Integer, j As Integer, d As Integer, e As Integer Dim 内積 As Integer, step As Integer Dim f As Integer, g As Integer, h As Integer, l As Integer, m As Integer, n As Integer, k As Integer, x As Integer Dim sum As Integer, total As Integer Dim aa As Integer, aaa As Integer, aaaa As Integer, bb As Integer, bbb As Integer, bbbb As Integer a = 3 '行 b = 3 '列 c = 0 内積 = 0 con = 0 sum = 0 tatal = 0 aa = 0 aaa = 0 aaaa = 0 bb = 0 bbb = 0 bbbb = 0 x = 0 For n = 0 To 2 For m = 0 To 2 For l = 0 To 2 For k = 0 To 2 For h = 0 To 2 For g = 0 To 2 For f = 0 To 2 For e = 0 To 2 For d = 0 To 2 '要素がすべて1 For i = 1 To a For j = 1 To b Cells(i, j) = 1 Next j Next i If bbbb = 1 Then Cells(a - 2, b - 2) = 0 ElseIf bbbb = 2 Then Cells(a - 2, b - 2) = -1 End If If bbb = 1 Then Cells(a - 1, b - 2) = 0 ElseIf bbb = 2 Then Cells(a - 1, b - 2) = -1 End If If bb = 1 Then Cells(a, b - 2) = 0 ElseIf bb = 2 Then Cells(a, b - 2) = -1 End If If aaaa = 1 Then Cells(a - 2, b - 1) = 0 ElseIf aaaa = 2 Then Cells(a - 2, b - 1) = -1 End If If aaa = 1 Then Cells(a - 1, b - 1) = 0 ElseIf aaa = 2 Then Cells(a - 1, b - 1) = -1 End If If aa = 1 Then Cells(a, b - 1) = 0 ElseIf aa = 2 Then Cells(a, b - 1) = -1 End If If total = 1 Then Cells(a - 2, b) = 0 ElseIf total = 2 Then Cells(a - 2, b) = -1 End If If sum = 1 Then Cells(a - 1, b) = 0 ElseIf sum = 2 Then Cells(a - 1, b) = -1 End If If con = 1 Then Cells(a, b) = 0 ElseIf con = 2 Then Cells(a, b) = -1 End If con = con + 1 Next d con = 0 sum = sum + 1 Next e sum = 0 total = total + 1 Next f total = 0 aa = aa + 1 Next g aa= 0 aaa = aaa + 1 Next h aaa = 0 aaaa = aaaa + 1 Next k aaaa = 0 bb = bb + 1 Next l bb = 0 bbb = bbb + 1 Next m bbb = 0 bbbb = bbbb + 1 Next n End Sub