[[20201211231919]]　『複雑な分岐処理』（TT）　ページの最後に飛ぶ

『複雑な分岐処理』（TT）

エクセルvbaの質問です。
かれこれ5日くらい考えているのですが、
複雑ゆえ、どのように記述すれば
よいのか分からず困っています。
どうかご教授頂きたいです。

質問
ある１つのシートの
C列には、重複ありの数字が入力されている。重複の数は不規則です。
E列には、都道府県名が入力されている。
F列には、りんご、みかん、すいかの内いずれかが入力されている。
G列には日付が。
H列には時間が入力されている。
F列がりんごであれば、GとH列は空白となっている。
F列にりんごとあるものを除き、C列の数字が２つ以上重複しているものを抽出し、
H列の日付とF列の時間を比較する。
HとFのどちらかが不一致であれば、りんごを除いたF列の重複番号からH列まで青色に
着色したい。

イメージ
C列 E列　　　　　F列　　　　　G列　　　　　　H列
1 島根　　　　すいか 12/10 10:00-10:10
2 鳥取　　　　みかん　　　　12/7 9:00-9:20
4 香川　　　　りんご
9 山形　　　　すいか　　　　12/13 11:20-12:40
2 秋田　　　　りんご
1 北海道　　　みかん　　　　12/10 14:30-14:50
0 兵庫　　　　すいか　　　　9/8 15:15-16:40
1 福井　　　　りんご
2 和歌山　　　すいか　　　　12/11　　　　　9:00-9:20

上のイメージ言うと、
C列で重複している数字の　1と2があります。
1の数字が入っている島根と北海道と福井。
福井はF列にりんごと入力されているので、無視する。
残りの島根と北海道のG列を見てみるとG列の日付は、12/10と一致しているが、
H列の時間が不一致のため、島根と北海道の行を青色に着色する。

2の数字が入っている鳥取と秋田と和歌山では、F列がりんごの秋田は無視。
H列の時間は同じだが、今度はG列の日付が不一致のため、同様に青色に
着色したい。

どうかよろしくお願いします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

条件を整理すると、

１　Ｃ列に重複があり、
２　Ｆ列がりんごでなく、
３　Ｇ列とＨ列のどちらかが不一致であれば着色する

ということでよろしいでしょうか。
ソートをかけてループで回すのが一番わかりやすい気がするのですが、いかがでしょうか。

＝＝以下サンプルコード＝＝

Sub Test()

'Ｉ列に連番を入力（あとでもとの順番に戻すため）

Dim lastRow As Long
lastRow = Cells(Rows.Count, 3).End(xlUp).Row

Dim i As Long
For i = 1 To lastRow

    Cells(i, 9) = i
Next

'C列とG列でソート

Range(Cells(1, 3), Cells(lastRow, 9)).Sort _
key1:=Range("C1"), order1:=xlAscending, key2:=Range("G1"), order2:=xlAscending

'C列が重複していて、かつ、Ｆ列が「りんご」ではない行のうち、すべてのＧ列とＨ列が同じで出なければ着色

Dim cnt As Long, doColor As Boolean
Dim j As Long, k As Long
j = 1

Do While Cells(j, 3) <> ""

    cnt = WorksheetFunction.CountIf(Columns(3), Cells(j, 3))

    If cnt = 1 Or Cells(j, 6) = "りんご" Then
        j = j + 1
    Else

        k = j

        Do While Cells(j, 3) = Cells(k + 1, 3) And Cells(k + 1, 6) <> "りんご"

             k = k + 1

            If Cells(j, 7) & Cells(j, 8) <> Cells(k, 7) & Cells(k, 8) Then
                doColor = True
            End If

        Loop

        If doColor Then
            Range(Cells(j, 7), Cells(k, 8)).Interior.ColorIndex = 5
            doColor = False
        End If

        j = k + 1

    End If

Loop

'もとの順番に戻す

Range(Cells(1, 3), Cells(lastRow, 9)).Sort key1:=Range("I1"), order1:=xlAscending
Columns(9).Delete

End Sub

（ひいらぎ） 2020/12/12(土) 08:27

 条件付き書式でもいい気がします！
 I1 =IF(AND(COUNTIF(C:C,C1)>1,F1<>"りんご"),C1&TEXT(G1,"_ yy/mm/dd_ ")&H1,"") J1 =IF(I1<>"",COUNTIF(I:I,I1)=1)
 J列で条件付き書式
 条件の文章化
 １）C列が重複且つF列がリンゴ以外の場合、
 ２）１）の条件と同じ行のH列とI列の組み合わせが異なる場合、着色

 下記のK列　←　が対象の行で大丈夫ですか？　
    |[C]|[D]|[E]   |[F]   |[G]     |[H]        |[I]                 |[J]  |[K]
 [1]|  1|   |島根  |すいか|12月10日|10:00-10:10|20/12/10 10:00-10:10|TRUE |← 
 [2]|  2|   |鳥取  |みかん|12月7日 |9:00-9:20  |20/12/07 9:00-9:20  |TRUE |← 
 [3]|  4|   |香川  |りんご|        |           |                    |FALSE|   
 [4]|  9|   |山形  |すいか|12月13日|11:20-12:40|                    |FALSE|   
 [5]|  2|   |秋田  |りんご|        |           |                    |FALSE|   
 [6]|  1|   |北海道|みかん|12月10日|14:30-14:50|20/12/10 14:30-14:50|TRUE |← 
 [7]|  0|   |兵庫  |すいか|9月8日  |15:15-16:40|                    |FALSE|   
 [8]|  1|   |福井  |りんご|        |           |                    |FALSE|   
 [9]|  2|   |和歌山|すいか|12月11日|9:00-9:20  |20/12/11 9:00-9:20  |TRUE |←

 と作っておいて疑問があるのですが、例えば
 　重複が3つある内、
 　2つはH,J列が合っていて
 　1つはずれている場合
 下記の場合、１-2行目の島根と鳥取は、着色なしですか？　ありですか？

    |[C]|[D]|[E] |[F]   |[G]     |[H]        |[I]                   |[J]  
 [1]|  1|   |島根|すいか|12月10日|10:00-10:10|1 20/12/10 10:00-10:10|FALSE
 [2]|  1|   |鳥取|すいか|12月10日|10:00-10:10|1 20/12/10 10:00-10:10|FALSE
 [3]|  1|   |香川|すいか|12月10日|12:00-12:30|1 20/12/10 12:00-12:30|TRUE 
（稲葉） 2020/12/12(土) 10:51

 考え方間違ってたかも
 もう一度整理したいので、J列の着色したい行に●つけてもらえませんか？

    |[C]|[D]|[E]   |[F]   |[G]     |[H]        |[I]                          |[J]
 [1]|  1|   |島根  |すいか|12月10日|10:00-10:10|1 すいか 20/12/10 10:00-10:10|   
 [2]|  1|   |鳥取  |すいか|12月10日|10:00-10:10|1 すいか 20/12/10 10:00-10:10|   
 [3]|  1|   |香川  |すいか|12月10日|12:00-12:30|1 すいか 20/12/10 12:00-12:30|   
 [4]|  2|   |山形  |すいか|12月13日|11:20-12:40|2 すいか 20/12/13 11:20-12:40|   
 [5]|  2|   |秋田  |みかん|12月13日|11:20-12:40|2 みかん 20/12/13 11:20-12:40|   
 [6]|  3|   |北海道|すいか|12月15日|15:00-15:30|3 すいか 20/12/15 15:00-15:30|   
 [7]|  3|   |青森  |すいか|12月15日|15:00-15:30|3 すいか 20/12/15 15:00-15:30|   
 [8]|  3|   |岩手  |みかん|12月15日|15:00-15:30|3 みかん 20/12/15 15:00-15:30|

 補足
 C列の・・・
 1は、3つのうち、2つか日時が合っているが、1つが異なる
 2は、F列がすいかとみかんで異なっているが、日時が合っている
 3は、日時がすべて合っているが、F列が2つはすいか、1つがみかんになっている

（稲葉） 2020/12/12(土) 11:10

ひいらぎ　さん

ご丁寧なコメントとコードの記述を頂きありがとうございました。
おかげさまで理想の動きになりました。
自分にとって1人では到底記述できないくらい
難しいものでしたので、本当に助かりました。
（TT） 2020/12/12(土) 12:31

稲葉　さん

ご提案頂きありがとうございます。
説明が不十分で申し訳ございませんでした。

重複が３つある場合で、
2つはG列とH列が一致していても、
残りの１つが不一致であれば
全てに着色したいと考えています。

F列のすいかとみかんが異なっていても、日時があっていれば着色はしません。

全て日時が一致しており、F列の２つがすいか、１つはみかんでも
日時が一致しているので着色はしません。

つまり、C列の重複した値をもつ者のうち、
日時が全て一致するか、しないかを判定したいと思っています。
（TT） 2020/12/12(土) 12:42

 ひいらぎさんのコードで完璧ですね。

 蛇足でしかないですが、条件付き書式の場合、こんな感じでもできそうですね。
 I1=if(and(countif(C:C,C1)>1,F1<>"りんご"),countifs(C:C,C1,G:G,G1,H:H,H1)<>countifs(C:C,C1,F:F,"<>りんご"),false)
 として、条件付き書式の数式に　=I1　でいかがでしょうか？
（稲葉） 2020/12/12(土) 13:37

稲葉　さん

ご返信ありがとうございます。
全く蛇足なんかではありません。
むしろ、vbaでしか判定出来ないと思っていたので、
条件付き書式でも出来るとは驚きました。
新たな視点でのご回答に感謝です。
ありがとうございました。
（TT） 2020/12/12(土) 13:48

 こんにちは！
方法は色々あると思います。
久しぶりに書いてみました。。。
良かったら参考にしてください。。。

 では、、では、、

 Option Explicit
Sub てすと()
Dim MyDicA As Object
Dim MyDicB As Object
Dim MyA As Variant
Dim MyColor As Range
Dim i As Long
MyA = Range("C1", Range("C" & Rows.Count).End(xlUp)).Resize(, 6).Value
Set MyDicA = CreateObject("Scripting.Dictionary")
Set MyDicB = CreateObject("Scripting.Dictionary")
For i = LBound(MyA, 1) To UBound(MyA, 1)
    If MyA(i, 4) <> "りんご" Then
        If Not MyDicA.exists(MyA(i, 1)) Then
            MyDicA(MyA(i, 1)) = MyA(i, 5) & MyA(i, 6)
        Else
            If MyDicA(MyA(i, 1)) <> MyA(i, 5) & MyA(i, 6) Then
                MyDicB(MyA(i, 1)) = Empty
            End If
        End If
    End If
Next
For i = LBound(MyA, 1) To UBound(MyA, 1)
    If MyA(i, 4) <> "りんご" Then
        If MyDicB.exists(MyA(i, 1)) Then
            If MyColor Is Nothing Then
                Set MyColor = Range("C" & i).Resize(, 6)
            Else
                Set MyColor = Union(MyColor, Range("C" & i).Resize(, 6))
            End If
        End If
    End If
Next
Range("C1", Range("C" & Rows.Count).End(xlUp)).Resize(, 6).Interior.Pattern = xlNone
MyColor.Interior.Color = vbBlue
Erase MyA
Set MyDicA = Nothing
Set MyDicB = Nothing
End Sub
（SoulMan） 2020/12/12(土) 14:03

SoulMan さん

ご返信ありがとうございます。
まだまだ自分が知らないコードが記述されており、
一目見たただけで高難易度であることが伺えます。
自分自身理解して記述出来るよう頑張ります。
ご提案頂きありがとうございました。
（TT） 2020/12/12(土) 20:46

コメント返信：

[ 一覧(最新更新順) ]

[[20201211231919]] 『複雑な分岐処理』（TT） ページの最後に飛ぶ

[[20201211231919]]　『複雑な分岐処理』（TT）　ページの最後に飛ぶ