abc9gad2016

回復 7# ML089

感謝ML版大的幫助，小弟原本嘗試用index與match函數求解，但礙於程度不佳，也沒辦法帶出完整的替代關係，總是發現遺漏的地方

下面准提部林版大的VBA已幫助我所需要的結果，也相當感謝ML版大的幫忙，感謝!!

應該是很簡單的問題被我講得這麼複雜，後來想想其實問題可以簡單化如下

下載 (12.32 KB)

2016-9-12 20:53

准提部林

回復 10# abc9gad2016


檢測一下資料，發現〔替代表〕C721 的 DN6818800 後面含有一個不可見字元及空白字元，
這會造成資料比對上的錯誤，須注意～～

以下程式碼可以試試看，清除ＢＣ欄空白字元及不可見字元（只針對AscW(160)）
Sub UURR()
[B:C].Replace ChrW(160), "", Lookat:=xlPart
[B:C].Replace " ", "", Lookat:=xlPart
End Sub

另外，替代群組若太多品項，造成字串太長，可能也會有比對出錯的問題，
我沒有去研究字典檔的key及item最多的字元限制（目前測過１０００個字元還可以）！！！

版上使用EXCEL的人，大部份是用到哪學到哪，有問題就是買些書．GOOGLE，或VBA內建說明檔找材料，
幾乎都是靠時間累積經驗的，這急不來～～

Andy2483

回復 9# 准提部林


    謝謝前輩
後學藉此範例學習陣列與字典,很多還看不懂,暫學習心得如下,請前輩再指導

執行前:

下載 (131.62 KB)

2023-4-28 16:14

執行結果:

下載 (190.79 KB)

2023-4-28 16:14

Sub Get_Group()
Dim Arr, Brr, Q, xD1, xD2, A$, b$, T$, TT$, S$, i&, N&, R&
'↑宣告變數:(Arr,Brr,Q,xD1,xD2)是通用型變數,(A,b,T,TT,S)是字串變數,
'(i,N,R)是長整數變數
Arr = Range([替代表!B2], [替代表!C1].Cells(Rows.Count, 1).End(xlUp))
'↑令Arr這通用型變數是 二維陣列,以替代表[B2]到 C欄最後有內容儲存格值帶入
Set xD1 = CreateObject("Scripting.Dictionary")
'↑令xD1這通用型變數是 字典
For i = 1 To UBound(Arr)
'↑設順迴圈!i從1到 Arr陣列縱向最大索引列號
    A = Arr(i, 1): b = Arr(i, 2): TT = ""
    '↑令A這字串變數是 i迴圈列第1欄Arr陣列值,
    '令b這字串變數是 i迴圈列第2欄Arr陣列值,令TT這字串變數是 空字元
    If A <> "" And b <> "" Then
    '↑如果A變數不是 空字元,且b變數也不是 空字元??
       T = xD1(A) & " " & xD1(b) & " " & A & " " & b
       '↑令T變數是 A變數當key查xD1字典的item值,連接空白字元,
       '連接b變數當key查xD1字典的item值,連接空白字元,連接A變數,
       '連接空白字元,最後連接b變數所組成的新字串
       For Each Q In Split(T, " ")
       '↑設逐項迴圈!令Q這通用型變數是 以空白字元切割T變數的一維陣列,其中一子
           If InStr(TT, Q) = 0 Then TT = Trim(TT & " " & Q)
           '↑如果TT變數字串裡沒有包含Q變數字串!就令TT變數是
           '(自身連接 空字元,再連接 Q變數)後去頭尾空白字元所組成的新字串
       Next
       For Each Q In Split(TT, " ")
       '↑設逐項迴圈!令Q這通用型變數是 以空白字元切割TT變數的一維陣列,其中一子
           If Q <> "" Then xD1(Q) = TT
           '↑如果Q變數不是 空字元!就令Q變數當key,item是 TT變數納入xD1字典中
       Next
    End If
Next i
'↑把所有有血緣關係的人都發一張戶口名簿
ReDim Brr(1 To UBound(Arr), 0)
'↑宣告Brr這通用型變數是二維陣列,縱向範圍從1到 Arr縱向最大索引列號,
'橫向範圍從0到0
For i = 1 To UBound(Arr)
'↑設順迴圈!i從1到 Arr縱向最大索引列號
    Brr(i, 0) = xD1(Arr(i, 1))
    '↑令i迴圈列0索引號欄陣列值是 以i迴圈列第1欄Arr陣列值查xD1字典得item值
Next i
[替代表!D2].Resize(UBound(Arr)) = Brr
'↑令替代表[D2]向下擴展 Arr陣列縱向最大索引號列數,
'這範圍儲存格值以Brr陣列值帶入
'------------------------------------------------------

Arr = Range([B2], Cells(Rows.Count, 2).End(xlUp))
'↑令Arr變數換裝現用工作表[B2]到 B欄最後有內容儲存格值
Set xD2 = CreateObject("Scripting.Dictionary")
'↑令xD2這通用型變數是 另一個字典
For i = 1 To UBound(Arr)
'↑設順迴圈!i從1到 Arr縱向最大索引列號
    T = xD1(Arr(i, 1))
    '↑令T變數是以i迴圈列第1欄Arr陣列值查 xD1字典得item值
    If T <> "" Then
    '↑如果T變數不是 空字元?
       S = xD2(T):  Q = S
       '↑令S這字串變數是 以T變數查 xD2字典得item值
       '令Q變數是 S變數值
       If S = "A" Then N = N + 1: Q = N
       '↑如果S變數是 "A"字元!就令N變數累加1,令Q變數是 N變數值
       If S = "" Then Q = "A"
       '↑如果S變數是空字元!就令Q變數是 "A"字元
       xD2(T) = Q
       '↑令以T變數當key,item是Q變數,納入xD2字典
    End If
Next

ReDim Brr(1 To UBound(Arr), 1)
'↑宣告Brr這通用型變數是二維陣列,縱向範圍從1到 Arr縱向最大索引列號,
'橫向範圍從0到1
For i = 1 To UBound(Arr)
'↑設順迴圈!i從1到 Arr縱向最大索引列號
    T = xD1(Arr(i, 1))
    '↑令T變數是 i迴圈列第1欄Arr陣列值查 xD1字典得item值
    Q = Val(xD2(T))
    '↑令Q變數是 以T變數查 xD2字典得item值轉成數值
    If Q > 0 Then Brr(i, 0) = Q: Brr(i, 1) = T
    '↑如果Q變數大於 0!就令i迴圈列0索引號欄Brr陣列值是 Q變數,
    '令i迴圈列第1欄Brr陣列值是 T變數值
Next

[D2:E2].Resize(UBound(Arr)) = Brr
'↑令[D2:E2]向下擴展Arr陣列縱向索引列號數範圍儲存格值,以Brr陣列值帶入
End Sub