Board logo

標題: 如何判斷為同一組(進階問題） [打印本頁]
作者: s7659109    時間: 2018-8-13 10:48     標題: 如何判斷為同一組(進階問題）

條件:當a欄b欄一致，但d欄出現字串不一致時,標示x，該列標示反黃
作者: a5007185    時間: 2018-8-13 11:02

回復 1# s7659109

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

先以A欄與B欄的資訊做分組，
若組內D欄出現兩種以上的資訊就Highlight？
作者: s7659109    時間: 2018-8-13 11:54

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

回復 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    時間: 2018-8-13 13:47

回復 4# naruto018


    最後面決定格式化可以直接判斷G欄是否為"x"
作者: s7659109    時間: 2018-8-13 14:12

如何改為vba方式？
作者: a5007185    時間: 2018-8-13 17:10

回復 6# s7659109

我VBA是承續之前的Code，
請參考
[attach]29208[/attach]
  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

  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
複製代碼
作者: 准提部林    時間: 2018-8-13 17:31

本帖最後由 准提部林 於 2018-8-13 17:33 編輯

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    時間: 2018-8-14 16:25

謝謝二位大大的回答,前面的問題ok,但還有另一問題:d欄,以vlookup取得資料(只會公式,已設了); e欄0清空
作者: 准提部林    時間: 2018-8-14 17:31

回復 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
作者: s7659109    時間: 2018-8-14 20:13

請問版主:用vlookup一定要排序,若要工作表acc 中a欄要加入排序功能該如何寫?
作者: 准提部林    時間: 2018-8-14 20:21

本帖最後由 准提部林 於 2018-8-14 20:23 編輯

回復 11# s7659109


VLOOKUP不用排序
原公式會需要排序, 是省了第四個參數(TRUE/FALSE)
VLOOKUP(找查值, 區域, 欄位, TRUE/FALSE)  用FALSE就不須排序(精確比對)

VLOOKUP(C2,accnum,2,FALSE)
VLOOKUP(C2,accnum,2,0)
VLOOKUP(C2,accnum,2,)
三個公式道理相同
作者: s7659109    時間: 2018-8-14 22:46

If TC = "" Then xD(T) = "|" & Arr(i, 4): GoTo 101
    If TC <> "|" & Arr(i, 4) Then xD(T) = "異常"
這一段不太懂,可否說明
作者: s7659109    時間: 2018-8-15 07:54

謝謝但下面那句,可否說明,多學一點
作者: 准提部林    時間: 2018-8-15 09:50

回復 13# s7659109

TC = xD(T)  
>> 取字典檔的 ITEM 值給 TC

If TC = "" Then xD(T) = "|" & Arr(i, 4): GoTo 101  
>> 如果TC是空值, 表示尚未帶入xD, 則給予D欄的值為ITEM,
    D欄文字前加"|", 是考慮D欄可能是空白的,  就會與 IF TC = "" 又產生循環

If TC <> "|" & Arr(i, 4) Then xD(T) = "異常"
>> 比較 TC 與 當前列D欄文字, 若不相同, 即是異常
作者: s7659109    時間: 2018-8-15 11:45

謝謝版主，又長進了
作者: s7659109    時間: 2018-8-15 15:17

接續問題:當soure有更新資料,工作表1會自動載入新資料進來
        當次月系統日期15日時,上個月辦理過帳(每個月)不得更動了[attach]29223[/attach]
作者: Andy2483    時間: 2023-5-30 10:01

回復 8# 准提部林


    謝謝論壇,謝謝前輩
後學藉此帖學習前輩的方案,方案學習心得註解如下,請前輩在指導

執行前:
[attach]36467[/attach]

執行結果:
[attach]36468[/attach]


Option Explicit
Sub NumberCode()
Dim Arr, i&, xD, T$, TC$
'↑宣告變數
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD變數是字典
Arr = Range([D2], [A65536].End(3))
'↑令Arr變數是 二維陣列,以A~D欄第2列以下儲存格值帶入陣列中
For i = 1 To UBound(Arr)
'↑設順迴圈!
    T = Arr(i, 1) & Arr(i, 2):  TC = xD(T)
    '↑令T變數是 第1欄與第2欄陣列值所組成的新字串,
    '令TC變數是 以T變數查xD字典回傳item值
    If TC = "" Then xD(T) = "|" & Arr(i, 4): GoTo 101
    '↑如果TC變數是空的!就令T變數當key,item是"|"字元連接第4欄陣列值,
    '所組成的新字串,然後就跳到101標示位置繼續執行
    If TC <> "|" & Arr(i, 4) Then xD(T) = "異常"
    '↑如果TC變數值不同於 "|"連接第4欄Arr陣列值?
    '就令T變數在xD字典裡的item值換為 "異常"字串
101: Next i
For i = 1 To UBound(Arr)
'↑設順迴圈!
    T = Arr(i, 1) & Arr(i, 2): Arr(i, 1) = ""
    '↑令T變數是 第1欄與第2欄陣列值所組成的新字串,
    '清除掉Arr陣列第1欄的值
    If xD(T) = "異常" Then Arr(i, 1) = "x"
    '↑如果以T變數查xD字典回傳item值是 "異常",
    '就令當列Arr陣列第1欄的值是 "x"
Next i
[G2].Resize(UBound(Arr)) = Arr
'↑令Arr陣列值從[G2]儲存格開始寫入,超過此範圍的陣列值忽略
End Sub
作者: Andy2483    時間: 2023-5-30 11:55

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列語字典,學習方案如下,請各位前輩指教

Option Explicit
Sub TEST()
Dim Brr, Y, i&, T$, T4$
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Brr = Range([D2], Cells(Rows.Count, 1).End(xlUp))
'↑令Brr變數是 二維陣列,以A~D欄第2列以下儲存格值帶入陣列中
For i = 1 To UBound(Brr)
'↑設順迴圈
   T = Brr(i, 1) & Brr(i, 2): T4 = Brr(i, 4) & "|"
   '↑令T變數是 第1欄與第2欄陣列值所組成的新字串,
   '令T4變數是 第4欄陣列值連接 "|"符號所組成的新字串
   If Y(T) <> T4 And Y(T) <> "" Then Y(T & "|") = "X" Else Y(T) = T4
   '↑如果T變數查Y字典得item值與 T4變數不同,而且
   '且T變數查Y字典得item值不是初始值!就令T變數連接"|"組成的新字串當key,
   'item是"X",納入Y字典中,
   '否則就令T變數當key,item是T4變數納入Y字典中
Next
For i = 1 To UBound(Brr)
'↑設順迴圈
   Brr(i, 1) = Y(Brr(i, 1) & Brr(i, 2) & "|")
   '↑令Brr陣列第1欄寫入 第1欄與第2欄陣列值連接"|"組成的新字串,
   '查Y字典回傳item值
Next
[G2].Resize(UBound(Brr)) = Brr
'↑令從[G2]儲存格開始寫入Brr陣列值,超過此範圍的陣列值忽略
Set Y = Nothing: Erase Brr
'↑令釋放變數
End Sub
作者: hcm19522    時間: 2023-5-30 12:35

H2=REPT("X",COUNTIFS(A:A,A2,B:B,B2,D:D,D2)<>COUNTIFS(A:A,A2,B:B,B2))



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)