VBA 結合されているセルのオートフィルのやり方

このQ&Aのポイント
  • VBAを使用して結合されているセルのオートフィルを行いたい場合、以下のコードを使うことができます。具体的な処理内容は、指定したセルに入力された値を検索し、該当する行の結合されているセルにオートフィルを行います。
  • まず、指定したセルの値を取得し、検索対象の行の結合されているセルを選択します。その後、選択したセルの一番上のセルを取得し、オートフィルの範囲を設定します。最後に、オートフィルを実行します。
  • 上記のコードは、指定したセルの値が空である場合にのみオートフィルを行います。また、オートフィルの範囲は指定したセルから上方向に検索し、空でないセルまでとなります。
回答を見る
  • ベストアンサー

VBA 結合されているセルのオートフィル

先程同じような質問をしてしまい すいませんが 結合されているセルのオートフィルのやり方が今一つわかりません でしたので質問させていただきます。 やりたいこと A列・・・A1セル『1』A2セル『2』・・・A10セル『10』と 数字が入っています。 BとC列・・・結合されており B1C1セル『1000』B2C2セル『1100』と数字が入っています。 F1セル・・・1~10までの数字が入っています。 処理内容 F1セルに『5』と数字が入っている場合 B5C5セルを選択後、数字が入っているB2C2セルまで移動します。 そのあと、B5C5セルではなく B4C4セルまで『1100』とオートフィルしたいのですが 可能でしょうか。 それともこのような処理をしたい場合オートフィルをするのは 間違っているのでしょうか? すいませんがコード記載していますので 回答宜しくお願い致します。 コード Sub Macro1() Dim a As Variant Dim i As Variant Dim RSta As Long Set a = Range("F1") '検索値'例えば5と入力したら For i = 1 To 10 If a.Value = Cells(i, 1).Value Then 'F1セルに5と入力されA5セルの数字が5なら If Cells(i, 2) = "" Then 'B5セルの値が何もなければ RSta = Cells(i, 2).End(xlUp).Row 'ここでBとCセルの結合されているセルの数字が入っている 一番上のセルを選択し Range("B" & RSta, "C" & RSta).AutoFill Destination:=Range("B" & RSta, "C"), Type:=xlFillCopy 'このコードが間違っているらしくうまくできません。ここでBとCの結合されているセル2行目から4行目までをオートフィル(数字のコピーのみを実施したい) End If End If Next i End Sub

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

  • ベストアンサー
  • SI299792
  • ベストアンサー率48% (715/1478)
回答No.1

https://okwave.jp/qa/q10048172.html の続きですね。前質問を閉じないと規約違反になります。 https://project.okwave.jp/utility/prohibition/ 「締め切らずに同一、または関連する質問を投稿」 プログラムを見ましたが、何で For i = 1 To 10 があるのか、何をしたいのか判りません。 F1: 5 の時4行目までコピー、但しB4が埋まっていたら何もしないのであれば。 オートフィルを使う、使わない。両方用意しました。 Option Explicit ' Sub Macro1() Dim RSta As Long ' If Cells([F1] - 1, "B") = "" Then RSta = Cells([F1], "B").End(xlUp).Row Range("B" & RSta, "C" & RSta).AutoFill _ Range("B" & RSta, "C" & [F1] - 1), xlFillCopy End If End Sub ' Sub Macro2() Dim RSta As Long ' If Cells([F1] - 1, "B") = "" Then RSta = Cells([F1], "B").End(xlUp).Row Range("B" & RSta, "C" & [F1] - 1).Merge True Range("B" & RSta, "B" & [F1] - 1) = Cells(RSta, "B") End If End Sub

TaikooniQ1
質問者

お礼

すいません質問閉じ忘れていました。 実現できました。 何回も答えて頂きありがとうございます。

その他の回答 (1)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

珍奇な内容の(たまたま質問者の、この場面でのみ有効な)課題で、時間が掛かったが、余り力が入らない。 エクセルで、セル結合の利用は、最終レポートの段階(別コピーしたシートで行う)などに限り(見てくれをよくする)行い、データ処理段階では、できるだけ避けるべきようだ。 VBAでの処理にも。データベース的利用では知毎的。ピボットテーブルなどでも。 ーー データ例  下記は質問の文章から作ったツモリ。理解に時間が掛かったーー真意を誤解しているかも。 (特に質問文の中の「・・・」の使い方が引っかかった。) A列は連番か?本件と意味があるのか? B,C列は同行は結合されている、とする。 A列 B列・C列    F列 1 1000 5 <ーーF1セルは5 2 1100 3 4 5 ーー 結果 A列 B列=C列と結合されている。空白に見える。 C列=下記 1 1000 2 1100 3 1101 4 1102 5 1103 標準モジュールに コメント部分も見ておいてください。 Sub test01() n = Cells(1, "F") 'F1セルの値を取得、数字とする 本件では5 Range("B" & n & ":C" & n).Select 'B5:C5を選択 Selection.End(xlUp).Select 'ENDキー+上↑を操作 B2:C2を選択状態 MsgBox "AAA" Selection.AutoFill Destination:=Range("B2:C" & n), Type:=xlFillSeries 'B2:C2をB5:C5までオートフィル End Sub ーー 本質問での、F1セルの5に当たるデータは、どうするの(人間判断の手入力か?)。 VBAならもっと別の分野の勉強が、沢山あるだろうに。

関連するQ&A

  • VBA オートフィルの操作方法

    VBAで使用するオートフィルの指定方法がわかりませんでしたので 質問いたします。 やりたいこと セルがAとBセルが一番下まで結合されている状態 (A1とB1セル結合・A2とB2セル結合・・・) にて、セル(A5とB5が結合されたセル)を選択し 何も数字が無ければ、数字があるセルまで選択する (この場合End(xlUp)にて数字がある一番上のセルを選択する) そのあと、セル(A5とB5が結合されたセルの一つ上)まで オートフィルをしたいのですが 下記のコードだと実現できませんでした。 おそらくrange指定がキチンとできていないのと セルが結合されているのも要因の様な気がします・・・ すいませんが実現できるコード記載お願いできますでしょうか。 回答宜しくお願い致します。 Cells(5, 1).End(xlUp).Select Selection.AutoFill Destination:=Range(Cells(5, 1).End(xlUp), Cells(5, 1).Offset(-1, 0)), Type:=xlFillCopy

  • 結合しているセルへのオートフィル

    セルの頭に式を入れていて、それを最終行までオートフィルしたいのですが、うまくいきません。 セルは全て2行ずつ結合しています。 その状態で With Cells(Rows.Count, 5).End(xlUp) .Offset(1, 1) = "最終判定" .Offset(1, 2) = "最終判定" .Offset(1, 3) = "最終判定" .Offset(1, 4) = "最終判定" .Offset(1, 5) = "最終判定" .Offset(1, 6) = "最終判定" .Offset(1, 7) = "最終判定" .Offset(1, 8) = "最終判定" .Offset(1, 9) = "最終判定" .Offset(1, 10) = "最終判定" .Offset(1, 11) = "最終判定" .Offset(1, 12) = "最終判定" Range("F5:F6").AutoFill Destination:=Range(Range("F5:Q6"), Selection.End(xlDown)), Type:=xlFillSeries というマクロを使用していますが(色々弄くり回していたので原型と少々変わってるかもしれません)、セルが結合している為出来ませんなどのエラーが出ます。 そこで回避手段として下記のマクロを組んでみました。 Public Sub testcode() 'ダミーデータ '5000行まで結合する為にダミーの判定用データを作成する(5000行までまずいかない) With Cells(5000, 5) .Offset(1, 1) = "最終行判定用" .Offset(1, 2) = "最終行判定用" .Offset(1, 3) = "最終行判定用" .Offset(1, 4) = "最終行判定用" .Offset(1, 5) = "最終行判定用" .Offset(1, 6) = "最終行判定用" .Offset(1, 7) = "最終行判定用" .Offset(1, 8) = "最終行判定用" .Offset(1, 9) = "最終行判定用" .Offset(1, 10) = "最終行判定用" .Offset(1, 11) = "最終行判定用" .Offset(1, 12) = "最終行判定用" End With '月の下のセルを結合する For m = 6 To 17 Set c = Cells(5, m) Cells(5, m).Activate Do Until c.Value <> "" Or c.Offset(1).Value <> "" c.Resize(2).Merge Set c = c.Offset(1) Loop Next m Range("F5") = "=IF~省略" Range("F5:F6").AutoFill Destination:=Range("F5:Q6"), Type:=xlFillSeries 'ダミーの5000行までオートフィルする Range("F5:Q6").AutoFill Destination:=Range("F5:Q5000"), Type:=xlFillSeries With Range("F5:Q5000") '選択範囲内で中央配置 .HorizontalAlignment = xlHAlignCenterAcrossSelection .Copy End With Range("F5").PasteSpecial Paste:=xlPasteValues 'コピーの解除 Application.CutCopyMode = False 'ダミーデータの選択 Range(Cells(Rows.Count, 5).End(xlUp).Offset(1, 1), Cells(Rows.Count, 5).End(xlUp).Offset(1, 12)).Select '削除 Range(Cells(Rows.Count, 5).End(xlUp).Offset(1, 1), Cells(5001, 17)).Delete End Sub 1.まず、F~Q列の5001行に文字を入れる 2.5000行まで2行ずつセルを結合する、F~Q列全て行う 3.F5にオートフィルしたい式を入れる 4.F5~Q6(ここも2行ずつ結合してあります)までオートフィルをする 5.F5~Q6に入っている式を下方向へオートフィルする 6.本来なら不要のダミーデータを選択し、削除する A~E列までは別にデータが入っていて、F~Q列はA~E列の最終行に合わせてオートフィルさせる、という目的で上記マクロを作成し使用しております。 一応これで動くのですが問題点があります。 1.5000行まで無駄なデータを入れているため結合処理が遅い(普段は300~1500程度だが中途半端に設定すると最終行が取得できない可能性があるため) 2.同じく無駄なデータの削除処理が遅い 以上2点が問題点となっております。 上記処理をなくしたいのですが、2行ずつの結合したセルに対して、位置が不明確な場合、オートフィルを飛ばすのは難しいでしょうか? よいマクロが有れば教えてください。

  • Excelで複数セルからの文字の結合

    B列からF列までのセルの内容を結合してH列に表示させるため、 以下のVBAを使用したのですが、結果が上手くいきません 原因など分かりましたら、指摘をお願いします マクロの内容 Sub test01() Dim c As Range Dim i As Long With ActiveSheet i = 1 Do While .Cells(i, "A") <> "" If .Cells(i, "A") <> "" Then For Each c In .Range(.Cells(i, "B"), .Cells(i, "B").Cells(i, "F")) .Cells(i, "H") = IIf(.Cells(i, "H") = "", c, .Cells(i, "H") & "/" & c) Next c Else .Cells(i, "H") = .Cells(i, "B") End If i = i + 1 Loop End With End Sub シートの内容  ABCDEFGH 1 1あいうえお 2 2か くけこ 3 3さし せそ 実行の結果 あ/い/う/え/お/ か/き/く/け/こ//さ/し//せ/そ/ さ/し//せ/そ///////////// 上記のようになってしまいます 2行目の「か/き/く/け/こ」の後に1行下の「さ/し//せ/そ」 が入っている状態です よろしくお願いします

  • 『エクセル』 vbaでオートフィルができない

    Sub Macro1() Range("a1:a10").Select Selection.AutoFill Destination:=Range("A1:A10"), Type:=xlFillSeries End Sub がエラーになります。 内容は「RangeクラスのAotofillメソッドが失敗しました」 となります。 Sub Macro2() Dim i As Long For i = 1 To 10 Cells(i, 1) = i Next End Sub や Sub Macro3() Dim i As Long i = 1 While i <= 10 Cells(i, 1) = i i = i + 1 Wend End Sub と同じような動きをAutoFillを使ってVBAで行いたいのですが むりでしょうか? というのも、 A1に長い関数式を入れて A10000までオートフィルしたいのですが 手作業だと時間がかかるためマクロで行いたいです。 アドバイス宜しくお願い致します。

  • VBA - セル解除

    コピーA列結合セルを解除して、解除した行にすべてに「OK」と入れたいのですがうまくいきません。 アドバイスをお願い致します。 Dim i, Addr Worksheets("Sheet1").Range("A:A").Copy With Worksheets("Sheet2") .Range("A1").PasteSpecial . . If .Cells(i, 1).MergeCells Then Addr = .Cells(i, 1).MergeArea.Address .Cells(i, 1).UnMerge .Cells(i, 1)(Addr) = "OK" '←ここがダメです。 End If . .

  • VBAでセルの結合と分割(解除)をお願いします

    宜しくお願いいたします。 H5とH6のどちらかに数字か記号が入っています以下30個のセルも同様です、H6にデータを入れH5とH6を結合するとセルの認識はH5を認識するのでH6のデータは他へコピー出来ないので結合したセルを再度分割して一行に並び変えているのに下記の構文で実行しているのですが結合にかなりの時間がかかっています。分割は瞬時にできています。 お願いしたい件は即時もしくはなるべく早い方法がありましたらお願いいたします。 こんな感じで作りました Sub 結合() For a = 8 To 38 Range(Cells(5, a), Cells(6, a)).Select Selection.Merge Range(Cells(7, a), Cells(8, a)).Select Selection.MergeSub 以降29個    ・    ・    ・ Next a End Sub 分割() Dim range1 As Range Set range1 = Range("H5:AL5") range1.MergeCells = False Set range1 = Range("H7:AL7") range1.MergeCells = False 以降29個   ・   ・    ・ End Sub 良い方法をご伝授宜しくお願いいたします

  • Excel VBA オートフィルの範囲指定

    Excel VBA で関数を入れたセルを最下行までコピー させたいのですが、範囲の指定がうまくできません。ごちゃごちゃ書きすぎて、よくわからなくなってしまいました。 実行してみたら、オートフィルのところでデバッグが出ました。 VBAはまだまだ初心者レベルです・・・ どこをどう直せばきちんと処理されるのか、どなたかお知恵をお貸しください。 (それと初めの定義は、Rangeで合ってるのでしょうか?) Sub sample() Dim MyCell1 As Range Dim MyCell2 As Range Dim MyCell3 As Range Dim MyCell4 As Range Dim MyCell5 As Range Set MyCell1 = Cells(5, Range("4:4").Find(what:="○○", searchorder:=xlByColumns).Offset(1, 1).Column) Set MyCell2 = Cells(5, MyCell1.Offset(0, 2).Column) MyCell1.Select Selection.Formula = "=$A5-" & MyCell2.Address(False, True) Set MyCell3 = Cells(5, MyCell1.Offset(0, -1).Column) Set MyCell4 = Cells(5, Cells(5, Columns.Count).End(xlToLeft).Column) Set MyCell5 = MyCell1.Offset(0, 1) MyCell5.Select Selection.Formula = "=" & MyCell3.Address(False, True) & "-" & MyCell4.Address(False, True) Range(MyCell1, Cells(5, MyCell1.Offset(0, 1).Column)).Select Selection.AutoFill Destination:=Cells(Cells(5, MyCell1.Column), Cells(Cells(Rows.Count, 1).End(xlUp).Row, MyCell5.Column)), Type:=xlFillCopy End Sub ********************* 下のような表に関数を入力して最下行までコピーさせたいです。  | A | B | C | D | E | F | G | H | I | J | K | L | -------------------------------------------------------------------------- 4 | code | name | 7/1 | 7/2 | ○○ |    |    | code|name| 7/1 | 7/2| ○○ | 5 |10000|aaaaaa| 15  | 20 | 35  |     |    |10001|bbbbbb| 13 | 25 | 38 |                           ((                            )) F5に "=$A5-$H5" と数式を入れてcodeを比較し、G5に "=$E5-$I5"と入れて数量を比較する。 F列とG列の入力されている最下行まで数式をコピーする。 ※毎月日数が変わり、商品数も変わるので、A列・B列・4行目以外は全て可変。 WindowsXP Excel2003 です。 よろしくお願いいたします。

  • VBAでオートフィルができません

    エクセル2007です。 画像のようにA列に値を入れて、B列に半角にする関数を入れて、最終行までオートフィルをしたいのですが、 --------------------------------------------------------- Sub test() Dim 最終行 As Long 最終行 = Cells(65536, 1).End(xlUp).Row ActiveCell.FormulaR1C1 = "=ASC(RC[-1])" Selection.AutoFill Destination:=Range("b1:b" & 最終行), Type:=xlFillDefault End Sub --------------------------------------------------------- をすると、 Selection.AutoFill Destination:=Range("b1:b" & 最終行), Type:=xlFillDefault の部分で、 [実行時エラー'1004'アプリケーション定義またはオブジェクト定義エラー] になってしまいます。 原因と対策を教えてください。ご回答よろしくお願いします。

  • 数式内のセルのオートフィル

    数式内のセルのオートフィル エラー値 #N/Aを返す数式 =IF(A1=0,NA(),A1) をA2に入力しているのですが、 この式ををA2~R2まで入力したいと思っています。 ひとつひとつ、=IF(A1=0,NA(),A1)、=IF(B1=0,NA(),B1)、=IF(C1=0,NA(),C1)…と 入力していけばいい話なのですが、 数が多いため、オートフィル機能のような形で連続セルを入力したいのですが、 なにかよい方法はないでしょうか?

  • 空白セルと0値を識別させたい。(VBA)

    すみません、誰か教えていただけますか。 シートの53、54、55行目にそれぞれ値入っています。 それを3行目にビジュアル的に表現させています。 55行目はセルの色で、53行目は数値があり同じ値が 続く部分の合計を出しています。 しかし、下記の記述ですと数値が0(変数D=0)の時に うまくいきません。空白セルと認識されてしまうと思います。 何か、良い方法があれば教えて頂けませんでしょうか。 宜しくお願いします。 Sub 表示() Dim a As Long Dim c As Long Dim D As Long Dim e As String Dim f As String c = 3 For a = 3 To 64 With Worksheets("Sheet1") If .Cells(53, a) <> .Cells(53, a + 1) Then .Range(.Cells(53, c), .Cells(53, a)).Select D = WorksheetFunction.Sum(Selection) e = D f = Selection(1).Offset(1, 0).Value G = Selection(1).Offset(2, 0).Value If D <> 0 Then Selection(1).Offset(-50, 0).Value = f + "//" + e .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.Interior.ColorIndex = G End If If Selection(1).Value = "" Then .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.ClearContents Selection.Interior.ColorIndex = xlNone End If c = a + 1 End If End With Next End Sub

専門家に質問してみよう