VBN セルの結合と、色分け

質問

VBN教えてください。
画像の左→右のようにしたいのですが、
まず、1列目の上下同じセルを結合します。
2列目、3列目は、1列目の結合範囲内で、上下同じセルを結合します。

さらに、結合された1列目を基準に、交互に色をつけたいのです。

詳しい方、教えていただけませんでしょうか。
よろしくお願い致します。

回答No.4

imogasi

すでに２回答が出ているが、当方でもやってみたので、参考に。
例データ　質問例を使う　Sheet2　A1:C21に、元データをコピーしてテストがよい。
１列目 ２列目 ３列目
a 1 5
a 1 5
b 1 6
b 1 6
b 1 6
b 1 7
b 1 7
b 1 7
b 1 7
c 2 7
c 2 7
c 2 7
c 2 7
c 2 7
d 2 6
d 2 6
d 2 6
d 2 6
d 3 6
d 3 6
ーー
大切な前提
A列を第Iソートキー
B列を第２ソートキー
でソートしてあるものとする。
ーーー
標準モジュールに
Sub test02()
Application.DisplayAlerts = False
Dim flg As Boolean
flg = True
Set sh1 = Worksheets("Sheet2")
'--
lr = sh1.Range("a10000").End(xlUp).Row
´MsgBox lr
'--初期設定
mk = sh1.Cells(2, "A") & "-" & sh1.Cells(2, "B") 'A列＋B列キー
s = 2 'スタートデータ行
r = 1 '結合範囲の行数
'---´各行で上行から繰り返し処理
For i = 3 To lr
k = sh1.Cells(i, "A") & "-" & sh1.Cells(i, "B")
If k = mk Then 'A列とB列文字列組み合わせで、変わったかどうから
r = r + 1
Else
'---変わった
sh1.Range("A" & s & "：A" & s + r - 1).MergeCells = True
sh1.Range("B" & s & "：B" & s + r - 1).MergeCells = True
sh1.Range("A" & s & "：C" & s + r - 1).Borders(xlBottom).LineStyle = xlSingle
'---塗りつぶしの色
If flg = True Then
sh1.Range("A" & s & "：C" & s + r - 1).Interior.Color = rgbYellow
Else
sh1.Range("A" & s & "：C" & s + r - 1).Interior.Color = rgbPink
End If
flg = Not flg '反転
'--
s = i
r = 1
End If
mk = sh1.Cells(i, "A") & "-" & sh1.Cells(i, "B")
Next i
'--データが終わった最後の後じまい
sh1.Range("A" & s & "：A" & s + r - 1).MergeCells = True
sh1.Range("A" & s & "：A" & s + r - 1).MergeCells = True
sh1.Range("B" & s & "：B" & s + r - 1).MergeCells = True
sh1.Range("A" & s & "：C" & s + r - 1).Borders(xlBottom).LineStyle = xlSingle
'---
If flg = True Then
sh1.Range("A" & s & "：C" & s + r - 1).Interior.Color = rgbYellow
Else
sh1.Range("A" & s & "：C" & s + r - 1).Interior.Color = rgbPink
End If
'----
Application.DisplayAlerts = True
End Sub
ーーー
塗りつぶしの色は黄色とピンクのような、薄い色にしている。
その他の色にするなら、WEBで「VBA　塗りつぶし色　RGB」で調べてください。
テストを繰り返す場合は、例えば下記を使ってクリアするとよい。
Sub test03()
Set sh1 = Worksheets("Sheet2")
'--テスト時用
sh1.Cells.Clear
sh1.Range("a1:C10000").MergeCells = False
sh1.Range("a1:C21").Interior.Color = xlNone
End Sub
ーー
実行結果　下記は回答記事では、列が崩れるかも（もちろん色は出ていない）しれないので、自分の実行結果の方を見てください。
１列目 ２列目 ３列目
a 1 5
5
b 1 6
6
6
7
7
7
7
c 2 7
7
7
7
7
d 2 6
6
6
6
d 3 6
6

お礼

解説もつけていただいてありがとうございます。
わかりやすかったです。