[[20160817092456]]　『同じ値が続く間背景色を交互に変更する方法』（ABCZ）　ページの最後に飛ぶ

『同じ値が続く間背景色を交互に変更する方法』（ABCZ）

初めて投稿します。
よろしくお願いいたします。

下記のようなＡ列からＣ列に文字入力があるシートの場合の質問です。

Ａ　Ｂ　　　Ｃ　

Ａ　TEST1　aaa　　・・・A1からC1迄の背景色は水色
Ａ　TEST1　aaa　　・・・A2からC2迄の背景色は水色
Ｂ　TEST2　bbb　　・・・A3からC3迄の背景色は黄色
Ｃ　TEST3 ccc　　・・・A4からC4迄の背景色は水色
Ｃ　TEST3 ccc　　・・・A5からC5迄の背景色は水色
Ｃ　TEST3 ccc　　・・・A6からC6迄の背景色は水色
Ｄ　TEST4 ddd　　・・・A7からC7迄の背景色は黄色
Ｄ　TEST4 ddd　　・・・A8からC8迄の背景色は黄色
Ｅ　TEST5 eee　　・・・A9からC9迄の背景色は水色

Ａ列にて同じ値が続く場合、対象行の背景色を水色とし
値が変更になった場合は対象行の背景色を黄色とする方法を
ＶＢＡで考えているのですがどの様に考えれば良いのでしょうか。

またＡ列で同じ値が続く場合Ａ列からＣ列迄のセルの結合を
加味したい場合の考え方も教えていただければと思います。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

こんにちは

随時処理でいいのですか？

Sub test()

    Dim r As Range
    Dim c As Variant
    Dim v As Long
    c = 16776960    '65535
    Range("A1:C2").Interior.Color = c
    v = Range("A" & Rows.Count).End(xlUp).Row
    If v = 1 Then Exit Sub
    For Each r In Range("A2:A" & v)
        If r.Value = r.Offset(-1).Value Then
            r.Resize(, 3).Interior.Color = c
        Else
            c = IIf(c = 16776960, 65535, 16776960)
            r.Resize(, 3).Interior.Color = c
        End If
    Next
End Sub

セルの結合については質問の意味が分かりません。

（ウッシ） 2016/08/17(水) 10:18

ウッシさん

ご回答ありがとうございました。
求めたい結果が得られました。

一つ一つ関数を読み解きながら勉強しています。

セルの結合につきましては
Ａ１からＣ２など同じ文字列が続きますので
そのような場合はセルの結合を用いて１行にしたいと
思っていました。

（ABCZ） 2016/08/17(水) 10:51

こんにちは

Ａ　TEST1　aaa

等の3セルの値は結合した1セルにまとめるという事ですか？

どのようにまとめるのですか？

スペースで？
カンマで？

それとも、A1:A2、B1:B2、C1:C2 をそれぞれ結合するという事ですか？

（ウッシ） 2016/08/17(水) 10:54

集計元のシートでは、セル連結はしないほうが良いですよ。同じ値が続いても、そのまま。
その方がオートフィルタや数式もうまく機能してくれます。部分的に結合すると、自動処理にいろいろ不都合が出て、苦労しそうです。

連結すべきでないものを連結し、そのせいで不具合が生じたといって、解決方法を質問しないように願います。おそらく、連結を止めなさい、という回答と、連結を判定するために複雑になったマクロ案が出るだけです。
（???） 2016/08/17(水) 11:07

 加工した姿を、単に見るだけの資料とするならいいのですが、さらに、これを、次に参照する元ネタにしょうとするなら
 ??? さん指摘の通り、扱いにくいものになります。

 なので、やるとしても、別シートに、その結合を加えたイメージを展開したほうがいいとは思いますが、さておき。

 A列だけで判定するのか、結合に関しては B,C列も含めて判定するのか、そのあたりが不明ですが
 以下は Aれつだけで判定しています。

 Sub Sample()
    Dim flg As Boolean
    Dim c As Range
    Dim f As Range

    Set f = Range("A1")

    For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp).Offset(1))
        If c.Value <> c.Offset(-1).Value Then
            With Range(f, c.Offset(-1)).Resize(, 3)
                .Interior.Color = IIf(flg, vbYellow, vbCyan)
                Application.DisplayAlerts = False
                .Columns(1).Merge
                .Columns(2).Merge
                .Columns(3).Merge
                Application.DisplayAlerts = False
            End With
            Set f = c
            flg = Not flg
        End If
    Next

 End Sub

（β） 2016/08/17(水) 11:29

ウッシさんへ

分かりにくい表現をしてしまい申し訳ありませんでした。

結論としましては
A1:A2、B1:B2、C1:C2 のような結合を想定しています。

（ABCZ） 2016/08/17(水) 12:28

???さん　βさんへ

ご忠告及びご回答ありがとうございます。
確かに元データにて結合を行うと後々不具合が出そうなので
実行する場合は別シートにて行います。

結合に関しましてはＡ列・Ｂ列・Ｃ列を含めた結合を考えています。

（ABCZ） 2016/08/17(水) 12:29

こんにちは

Sheet1からSheet2に転記して実行するようにすると、

Sub test1()

    Dim m   As Range
    Dim r   As Range
    Dim c   As Variant
    Dim v   As Long
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet

    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("Sheet2")

    sh2.UsedRange.Clear
    sh1.Range("A1").CurrentRegion.Copy sh2.Range("A1")

    With sh2
        c = 16776960    '65535
        .Range("A1:C1").Interior.Color = c

        Set m = .Range("A1")

        v = .Range("A" & Rows.Count).End(xlUp).Row
        If v = 1 Then Exit Sub
        Application.DisplayAlerts = False
        For Each r In .Range("A2:A" & v)
            If r.Value = r.Offset(-1).Value Then
                r.Resize(, 3).Interior.Color = c
            Else
                c = IIf(c = 16776960, 65535, 16776960)
                r.Resize(, 3).Interior.Color = c
                .Range(m, r.Offset(-1)).Merge
                .Range(m.Offset(, 1), r.Offset(-1, 1)).Merge
                .Range(m.Offset(, 2), r.Offset(-1, 2)).Merge
                Set m = r
            End If
        Next
        Application.DisplayAlerts = True
    End With
End Sub

こんな感じでしょうか？

（ウッシ） 2016/08/17(水) 15:03

ウッシさんへ

ご回答ありがとうございます。

元データを崩さずにセルの結合が可能となっていますので
まさに欲しかった結果そのものです。

一つ一つ関数を読み解いていきます。

本当にありがとうございました。
（ABCZ） 2016/08/17(水) 18:22

コメント返信：

[ 一覧(最新更新順) ]

[[20160817092456]] 『同じ値が続く間背景色を交互に変更する方法』（ABCZ） ページの最後に飛ぶ

[[20160817092456]]　『同じ値が続く間背景色を交互に変更する方法』（ABCZ）　ページの最後に飛ぶ