Sub TEST() '2個陣列方式
Dim Brr, Crr, Y, i&, T$, R&, N&
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是字典
Brr = Range([B2], Cells(Rows.Count, "B").End(3))
'↑令Brr變數是 二維陣列,以B欄儲存格值帶入
R = UBound(Brr): ReDim Crr(1 To R, 1 To 2)
'↑令R變數是 Brr陣列縱向最大索引列號,
'令Crr變數是 二維空陣列,縱向範圍同Brr陣列,橫向1~2
For i = 1 To R: T = Brr(i, 1): N = Y(T) + 1: Crr(i, 1) = N: Y(T) = N: Next
'↑設順迴圈!令T變數是Brr陣列值,令N變數是以T變數查Y字典item值累加1,
'令Crr陣列第1欄寫入N變數值,令在Y字典裡T變數key其item值是N變數值
For i = 1 To R: Crr(i, 2) = Y(Brr(i, 1)): Next
'↑設順迴圈!令Crr陣列第2欄寫入(以Brr陣列值查Y字典得到的item值)
[C2].Resize(R, 2) = Crr
'↑令從[C2]開始的範圍儲存格寫入Crr陣列值
End Sub
Sub TEST_1() '1個陣列方式
Dim Brr, Y, i&, T$, R&, N&
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是字典
Brr = Range([B2], Cells(Rows.Count, "A").End(3))
'↑令Brr變數是 二維陣列,以A~B欄儲存格值帶入
R = UBound(Brr)
'↑令R變數是 Brr陣列縱向最大索引列號
For i = 1 To R: T = Brr(i, 2): N = Y(T) + 1: Brr(i, 1) = N: Y(T) = N: Next
'↑設順迴圈!令T變數是第2欄Brr陣列值,令N變數是以T變數查Y字典item值累加1,
'令Brr陣列第1欄寫入N變數值(取代掉原陣列值),
'令在Y字典裡T變數key其item值是N變數值
For i = 1 To R: Brr(i, 2) = Y(Brr(i, 2)): Next
'↑設順迴圈!令Brr陣列第2欄寫入(以第2欄Brr陣列值查Y字典得到的item值)
[C2].Resize(UBound(Brr), 2) = Brr
'↑令從[C2]開始的範圍儲存格寫入Brr陣列值
End Sub