如何判斷為同一組(進階問題）

s7659109

條件:當a欄b欄一致，但d欄出現字串不一致時,標示x，該列標示反黃

a5007185

回復 1# s7659109

我先描述一下你的問題，
你看一下是不是這樣？

先以A欄與B欄的資訊做分組，
若組內D欄出現兩種以上的資訊就Highlight？

s7659109

是，a.b欄為一組（相同字串），但d欄的字串也要列入考慮，要一致（例：rows(2:12)都是a 以空白表示）,但若有不同，出現反黃與x提示，如rows(13:18)有不同者

naruto018

回復 3# s7659109

標示x：
G2填入，其餘下拉

1. =IF(COUNTIFS(A:A,A2,B:B,B2)=COUNTIFS(A:A,A2,B:B,B2,D:D,D2),"","x")

複製代碼

標示反黃：
格式化條件
使用公式決定格式化

1. =COUNTIFS($A:$A,$A2,$B:$B,$B2)<>COUNTIFS($A:$A,$A2,$B:$B,$B2,$D:$D,$D2)

複製代碼

範圍：A2:G27

a5007185

回復 4# naruto018


    最後面決定格式化可以直接判斷G欄是否為"x"

s7659109

如何改為vba方式？

a5007185

回復 6# s7659109

我VBA是承續之前的Code，
請參考
0801.zip (18.47 KB)

下載次數: 5

2018-8-13 17:11

1. Sub NumberCode()
   
2.     Dim i%, Str$, ArrStr$
   
3.     i = 2
   
4.     ArrStr = "" '清空已記錄到的條件
   
5.     Do Until Range("C" & i) = ""
   
6.         '將A欄、B欄、D欄合併為一個字串作為條件
   
7.         Str = Range("A" & i) & Range("B" & i)
   
8.         '若該條件未記錄過，則記錄之。
   
9.         If InStr("," & ArrStr & ",", "," & Str & ",") = 0 Then ArrStr = ArrStr & "," & Str
   
10.         '撈出Str在陣列ArrStr中的索引值
    
11.         Range("F" & i) = "No. " & UBound(Split(Split(ArrStr, Str)(0), ","))
    
12.         i = i + 1
    
13.     Loop
    
14.     ConsistentJudgment ArrStr, UBound(Split(ArrStr, ","))
    
15. End Sub
    
16. 
    
17. Sub ConsistentJudgment(ArrStr, R%)
    
18.     Dim i%, Str$, N%, StrMeno$
    
19.     ReDim ArrMemo(R) As String
    
20.     '紀錄Memo資料種類
    
21.     i = 2
    
22.     Do Until Range("C" & i) = ""
    
23.         Str = Range("A" & i) & Range("B" & i)
    
24.         StrMeno = Range("D" & i)
    
25.         N = UBound(Split(Split(ArrStr, Str)(0), ","))
    
26.         If InStr("," & ArrMemo(N) & ",", "," & StrMeno$ & ",") = 0 Then ArrMemo(N) = ArrMemo(N) & "," & StrMeno
    
27.         i = i + 1
    
28.     Loop
    
29.     '回饋判定結果
    
30.     i = 2
    
31.     Do Until Range("C" & i) = ""
    
32.         Str = Range("A" & i) & Range("B" & i)
    
33.         StrMeno = Range("D" & i)
    
34.         N = UBound(Split(Split(ArrStr, Str)(0), ","))
    
35.         If UBound(Split(ArrMemo(N), ",")) > 1 Then Range("G" & i) = "x"
    
36.         i = i + 1
    
37.     Loop
    
38. End Sub

複製代碼

准提部林

Sub NumberCode()
Dim Arr, i&, xD, T$, TC$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([D2], [A65536].End(3))
For i = 1 To UBound(Arr)
　　T = Arr(i, 1) & Arr(i, 2):  TC = xD(T)
　　If TC = "" Then xD(T) = "|" & Arr(i, 4): GoTo 101
　　If TC <> "|" & Arr(i, 4) Then xD(T) = "異常"
101: Next i
For i = 1 To UBound(Arr)
　　T = Arr(i, 1) & Arr(i, 2): Arr(i, 1) = ""
　　If xD(T) = "異常" Then Arr(i, 1) = "x"
Next i
[G2].Resize(UBound(Arr)) = Arr
End Sub
　
　

s7659109

謝謝二位大大的回答,前面的問題ok,但還有另一問題:d欄,以vlookup取得資料(只會公式,已設了); e欄0清空

准提部林

回復 9# s7659109


With Range("D2:D" & [A65536].End(3).Row)
　　.Formula = "=IF(ISNA(VLOOKUP(C2,accnum,2,)),"""",VLOOKUP(C2,accnum,2,))"
　　.Value = .Value
End With
Range("E:E").Replace 0, "", Lookat:=xlWhole