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
