[[20260318041536]]　『条件を付けたセルの結合』（NK）　ページの最後に飛ぶ

『条件を付けたセルの結合』（NK）

B列が空白の時に、D・I・J・Q列のセルを結合して
中央揃えにしたいです
マニュアル操作でフィルター抽出しても
旨くいきませんでしたのでマクロでお願いします
最初から作った時は結合していなくて、この度仕様変更をしたくなりました
A列の最終行までデータが入っております
A列は空白行はありません
使用最終列はS列です
結合したいセルのD列にデータが入っております(この列のデータが中央揃えに
活かされます)
この4列以外の間の列とR・S列は非表示にして罫線で囲った表にしております
どうぞよろしくお願いします

＜使用 Excel：Microsoft365、使用 OS：Windows11 ＞

Sub B空白行でDIJQ結合()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim r As Long
    Dim rng As Range

    Set ws = ActiveSheet   '必要なら Worksheets("○○") に変更
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row  'A列最終行まで

    Application.ScreenUpdating = False

    For r = 2 To lastRow   '見出しが1行目想定なら2行目から
        'B列が空白の行だけ処理
        If ws.Cells(r, "B").Value = "" Then

            'D・I・J・Q列のセルを結合
            Set rng = ws.Range("D" & r & ",I" & r & ",J" & r & ",Q" & r)
            With rng
                .Merge
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With

            '結合セルの値はD列の値を使う
            ws.Cells(r, "D").Value = ws.Cells(r, "D").Value

        End If
    Next r

    Application.ScreenUpdating = True

End Sub

（稚拙） 2026/03/18(水) 06:12:37

 セル書式に「選択範囲内で中央」というのがあるので、それを利用してはどうですか？
 D,I:J,Q列のうち、B列が空白行の行については、
 D列の入力だけを活かし、4つの可視列をあたかも結合セルのように
 選択範囲を中央揃えするものとしました。（別の前提であれば、簡単に修正可能でしょう）

 コードの作成にあたっては稚拙さんの回答を下敷きにさせていただきました。(thanks a lot)
 ご自由に修正して下さい。

 Sub test()
     Dim ws      As Worksheet
     Dim lastRow As Long
     Dim r       As Long
     Dim rng     As Range

     Set ws = ActiveSheet
     lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row  'A列最終行まで

     For r = 2 To lastRow
         If ws.Cells(r, "B").Value = "" Then
             Set rng = ws.Range(ws.Cells(r, "D"), ws.Cells(r, "Q"))
             Call setting(rng)
         End If
     Next
 End Sub

 Function setting(rng As Range)
     Dim rng2 As Range, v As Variant

     v = rng.Cells(1)
     Set rng2 = rng.SpecialCells(xlCellTypeVisible)
     rng2.ClearContents
     rng.Cells(1) = v

     With rng2
         .HorizontalAlignment = xlCenterAcrossSelection ''選択範囲内で中央
         .VerticalAlignment = xlCenter
     End With
 End Function

 ちなみに、セル結合ではうまくいかないと思います。
 D,I:J,Q列だけを結合セルにすることはできないと思います。（Excelの仕様でしょう）
 可能なのは、次のいずれかでしょう。
 ・D:Qをまとめて結合セルにする。（その場合、E:H列やK:P列にあるデータは消去されます）
 ・E:H列やK:P列にある情報を残したいなら、D列、I:J列、Q列をそれぞれひとつの別のグループとして
   扱うこと（I:J列の結合は可能）
 だけでしょう。

（xyz） 2026/03/18(水) 07:15:43

 結合するのは縦なのか横なのか？
（とおりすがり） 2026/03/18(水) 07:28:07

既に指摘がありますが、非表示にしていようがいまいが、飛び飛びの【列】を結合するのは無理です。
代替案として、「この4列以外の間の列とR・S列は非表示」ということを利用して、以下のようにするのはどうでしょうか？

 １．表範囲を取得する
 ２．↑の可視セルのみをコピーして、別シートに貼り付ける
 ３．↑でコピーしたほうの表で行ごとに（判定して）セル結合を行う

すなわち、データと表示用のシートを分けて運用するということです。
セル結合したいのは印刷用か目視確認用のためと推測しますが、データとして扱うときにセル結合してると逆にマズい場合が出てくるのではないかとおもいます。

（もこな２） 2026/03/18(水) 07:45:39

 >D・I・J・Q列のセルを結合

 意味が解らない
 最近自分でできると思い込んだ質問が多いような気がする
（What） 2026/03/18(水) 07:50:39

みなさま早朝からご回答ありがとうございます

（稚拙）さまのは、最初は何も変化しなかったので
Set ws = Worksheets("Sheet1") '必要なら Worksheets("○○") に変更してみましたがこれも変化なしでした

（xyz）さまのは結合は無理とのことなので分離したままで結局その4列をあたかも結合したかように見せかけてＤ列の文字データが中央に来てくれればいいので結果としてはこれで動作ＯＫです

（とおりすがり）さま。結合はご覧のように横方向でした。説明不足すいませんでした

当方のそれぞれのブックはデータ数が多く時間がかかるマクロが多いので、そのためだけに先日遂にCoreT i9-13900H (2.60 GHz)メモリDDR5を手に入れてしまいました
core i7の時より格段に動作が向上しました(スレッド数がかなり影響することが分かりました）
今回のマクロは約8万行中、B列空白行が約2700行あります
約10分ほど要しましたがとても満足いくものに仕上げていただきました

この報告を持ちまして解決とさせていただきます
この度は誠にありがとうございました
（NK） 2026/03/18(水) 09:20:28

コメント返信：

[ 一覧(最新更新順) ]

[[20260318041536]] 『条件を付けたセルの結合』（NK） ページの最後に飛ぶ

[[20260318041536]]　『条件を付けたセルの結合』（NK）　ページの最後に飛ぶ