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

Question

セルの頭に式を入れていて、それを最終行までオートフィルしたいのですが、うまくいきません。
セルは全て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

１．まず、F～Q列の5001行に文字を入れる
２．5000行まで2行ずつセルを結合する、F～Q列全て行う
３．F5にオートフィルしたい式を入れる
４．F5～Q6（ここも2行ずつ結合してあります）までオートフィルをする
５．F5～Q6に入っている式を下方向へオートフィルする
６．本来なら不要のダミーデータを選択し、削除する

A～E列までは別にデータが入っていて、F～Q列はA～E列の最終行に合わせてオートフィルさせる、という目的で上記マクロを作成し使用しております。
一応これで動くのですが問題点があります。

１．5000行まで無駄なデータを入れているため結合処理が遅い（普段は300～1500程度だが中途半端に設定すると最終行が取得できない可能性があるため）
２．同じく無駄なデータの削除処理が遅い

以上2点が問題点となっております。
上記処理をなくしたいのですが、2行ずつの結合したセルに対して、位置が不明確な場合、オートフィルを飛ばすのは難しいでしょうか？

よいマクロが有れば教えてください。

xls88 · Accepted Answer

こんな感じでどうでしょうか。

Dim rw As Long
    
    rw = Cells(Rows.Count, 5).End(xlUp).Row
    Application.ScreenUpdating = False
    With Range("F5:F6")
        .Merge
        .Formula = "=Sheet2!A1"
    End With
    Range("F5:F6").AutoFill Destination:=Range("F5:Q6"), Type:=xlFillSeries
    Range("F5:Q6").AutoFill Destination:=Range("F5:Q" & rw), Type:=xlFillSeries
    Application.ScreenUpdating = True

tsubuyuki · Answer

読み返して、「あ～、そうか。」とようやく納得。

> １．まず、F～Q列の5001行に文字を入れる
> ２．5000行まで2行ずつセルを結合する、F～Q列全て行う
> ３．F5にオートフィルしたい式を入れる
> ４．F5～Q6（ここも2行ずつ結合してあります）までオートフィルをする
> ５．F5～Q6に入っている式を下方向へオートフィルする

要するに、結合してからフィルしようとしているのですね。

１．Ｆ５セルにオートフィルしたい式を入力
２．Ｆ５・Ｆ６セルを結合
３．Ｑ列まで（結合されていない）列方向にフィル
４．最終行まで（結合されていない）行方向にフィル
の順番のほうが良いですよ。

マクロを使わずに、エクセルで直接フィルする時も
途中に結合セルがあると失敗することがありますよね。
マクロでもそれと同様ですから。

tsubuyuki · Answer

うまく伝わらなかったようなので。
少々長くなりますがご容赦ください。

「オートフィル」がお好みのようですね。
じゃあ、オートフィルでいきましょう。

この場合に問題になるのは、Ａ～Ｅ列が「どのように入力されているか、ですね。
５・６行目についてだけ、まずは考えて見ます。
考えられるパターンは３つ
・５行目だけに値が入っている
・６行目だけに値が入っている
・どちらも値が入っている
と言うパターンですね。

コレ以降の行に拡張すると、
・奇数行だけに値が
・偶数行だけに値が
・どちらにも値が
と言う３パターンに加えて
・混在している
と言う４つ目のパターンも考えられます。

また例外として、
・どちらも空白である
と言う選択肢も発生するかもしれません。
ただし、これはうまくないのは言うまでもありませんね。
もし実際の最終行がこの状態（奇数偶数どちらも空白）なのであれば、
データまたは最終行判定条件を見直すことを強くオススメします。

続いて最終行を判定する条件。
奇数行（５行目）から開始して、２行ごとに結合していくのですから、
「処理後の最終行は必ず偶数行である」と言えます。

２行を結合したセルを下（行）方向にフィルしていくわけです。
処理する行数が奇数だと、最終的に「く都合するべきセルが範囲に無い」ため、
エクセルはエラーを返すしかなくなるわけです。

つまり、xlupなどで見つけた最終行が奇数なら（処理範囲の行数が奇数なら）、
次の行（偶数行）までの処理（処理行数が偶数）であると置き換える必要があります。
見つけた最終行が偶数行（処理行数が偶数）であれば、そのまま処理を流してＯＫです。

これが解れば、
> 中途半端に設定すると最終行が取得できない可能性
は無いことが解ります。
つまり、奇数行で終わる場合は「次の行まで」
偶数行で終わるなら「その行まで」と言う終了条件をつければ良いのです。

見た感じ、Ｅ列を基準に「最終行」を拾っているようですので、
とりあえず、それを採用して書いてみます。

Sub sample1()
Dim MaxRow As Long

MaxRow = Cells(Rows.Count, 5).End(xlUp)　' 実データＥ列の最終行取得
　　　　If MaxRow Mod 2 = 1 Then MaxRow = MaxRow + 1　'最終行が奇数なら次の行までに拡張

With Range("F5")　' Ｆ５セルに対して
　　　　　　　　.Value = "=SUM($E5:E5)"　' 式を文字列として入力（仮）
　　　　　　　　.Resize(2, 1).Merge　' 下のセル（Ｆ６セル）と結合
　　　　End With

' 横方向にＱ列までフィル
　　　　Range("F5:F6").AutoFill Destination:=Range("F5:Q6"), Type:=xlFillDefault

' 縦方向にＭａｘＲｏｗ行目までフィル
　　　　Range("F5:Q6").AutoFill Destination:=Range("F5:Q" & MaxRow), Type:=xlFillDefault
End Sub

入力したい式がわかりませんので適当な式を文字列で入力していますが、
ここはもちろんお使いの式に直してくださいませ。
文字列を入力する場合は
　　　　.Value = "文字列"
としてやればＯＫです。

図は"文字列"を入力して走らせた結果です。
実際のデータの最終行が奇数行（２１行目）ですので、
その下の行（２２行目）までを範囲として判定しています。
見やすいかどうかはわかりませんが、罫線を入れ、
結合された行を１行おきに色をつけています。
上記の
・奇数行だけに値が（１１・１２行目など）
・偶数行だけに値が（１５・１６行目）
・どちらにも値が（５・６行目など）
つまり
・混在している
と言う入力条件を全て網羅していると言うこと、
及び、データの途中であれば
・どちらも空白（７・８行目）
にも対応できているのが確認いただけると思います。
（重ねますが、最終行が「どちらも空白」には対応できません。）

ちなみにコレで５０００行でも１秒かかりません。
（パソコンのスペックにもよるでしょうが、気になる遅さではないはずです。）

前の回答で言いたかったことは
「とりあえずいろいろな可能性を考えて、実際に動かしてみてください。」
と言うことです。
オートフィルにこだわらず、１セルずつ結合していく手段もありますよ、と言うことですね。
その他にも、
横方向にフィルが出来たのであれば、それをコピーして１行おきに貼り付ける手段もあるわけです。

ひとまず、上記コードを一度走らせてみてください。
で、ご自身のコードと見比べて補完なさってください。

xls88 · Answer

提示例に則ってやるとすれば

With Cells(Rows.Count, 5).End(xlUp)
        Range(.Offset(1, 1), .Offset(1, 12)).value = "最終判定"
    End With
    With Range("F5:Q6")
        .AutoFill Destination:=Range(.Cells, .Cells.End(xlDown).Offset(-1)), Type:=xlFillSeries
    End With

tsubuyuki · Answer

長いので詳しく読んでいませんが・・

要するに
・１行おきにデータ（式など）を入力
・２行１列ずつ結合
したいのでしょうか。

何かの参考になるかもしれませんので、
新規ブックで下記を走らせてみてください。

Sub sample()
　　　　For i = 1 To 5000 Step 2
　　　　　　　　Cells(i, 1) = "あ"
　　　　　　　　Cells(i, 1).Resize(2, 1).Merge
　　　　Next
End Sub

まぁつまり、入力と結合を一気にやってみようと言うだけのことです。
さすがに５０００行をこなそうと思ったら時間はかかりますけどね。

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

こんな感じでどうでしょうか。

読み返して、「あ～、そうか。

うまく伝わらなかったようなので。

提示例に則ってやるとすれば

長いので詳しく読んでいませんが・・

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング