| 
    
     |  | >デバッグしながら、闇雲アプローチで 
 >わかりにくいと思いますが
 >この辺の考え方アドバイス頂けると嬉しいです
 
 
 訳のわからない書き込みん申し訳ありませんでした
 
 再現出来ずに申し訳ないのですが
 ももさんにご提示頂いたコードで
 
 ElseIf flgStyle Then
 Set rngBuf = Application.Union(rngBuf, c)
 で
 オブジェクト Is Nothing エラー みたいなことがありました
 
 動作確認とエラー回避のため、下のような修正を行いました
 
 で、下記Qが出てしまいました
 
 Q1
 '←コレ2
 で、セルの背景色がピンクになる場合はどのようなときでしょうか
 
 Q2
 再現できないエラーで申し訳ないのですが
 '←コレ1 で 回避したエラー処理は、不適切でしょうか
 
 Q3
 '←コレ1 と '←コレ2
 とは、重複しているような気もしますがどうなんでしょう
 
 
 アドバイスあればよろしくお願いいたします
 
 
 Option Explicit
 
 
 Sub test2()
 
 Dim rngBuf As Range, c As Range
 Dim flgStyle
 Dim flgValue
 
 For Each c In Selection
 
 flgStyle = (c.HorizontalAlignment = xlCenterAcrossSelection)
 flgValue = (c.Value <> "")
 
 If flgStyle And flgValue Then
 
 If rngBuf Is Nothing Then
 Set rngBuf = c
 Else
 Debug.Print rngBuf.Address
 rngBuf.Interior.ColorIndex = 43 '緑
 Set rngBuf = c
 End If
 
 ElseIf flgStyle Then
 
 'Set rngBuf = Application.Union(rngBuf, c)
 
 'On Error Resume Next
 'Set rngBuf = Application.Union(rngBuf, c)
 'On Error GoTo 0
 
 'If rngBuf IsNot Nothing Then  'NG
 '  Set rngBuf = Application.Union(rngBuf, c)
 'End If
 
 If Not rngBuf Is Nothing Then
 Set rngBuf = Application.Union(rngBuf, c)  '←コレ1
 End If
 
 
 ElseIf Not rngBuf Is Nothing Then
 Debug.Print rngBuf.Address
 rngBuf.Interior.ColorIndex = 6 '黄
 Set rngBuf = Nothing
 End If
 
 Next c
 
 If Not rngBuf Is Nothing Then  '←コレ2
 Debug.Print rngBuf.Address
 rngBuf.Interior.ColorIndex = 38 'ピンク
 Set rngBuf = Nothing
 End If
 
 End Sub
 
 
 サンプルDT増やしてみました
 
 Sub SET_DT3()
 
 Range("B2").Value = ">゜))))彡   魚"
 Range("B2:D2").HorizontalAlignment = xlCenterAcrossSelection
 
 Range("F2").Value = ">゜))))彡2   魚"
 Range("F2:H2").HorizontalAlignment = xlCenterAcrossSelection
 
 Range("B4").Value = "くコ:彡   いか"
 Range("B4:D4").HorizontalAlignment = xlCenterAcrossSelection
 
 Range("E4").Value = "~ >゜)〜〜〜    へび"
 Range("E4:H4").HorizontalAlignment = xlCenterAcrossSelection
 
 
 Range("B2:H4").Copy
 Range("B8").PasteSpecial
 Range("D14").PasteSpecial
 Application.CutCopyMode = False
 
 Range("B1:J17").Select
 
 
 End Sub
 
 |  |