Option Explicit
Sub TEST_1()
Dim Brr, Y, i&, X&, xR As Range
'↑宣告變數:(Brr,Y)是通用型變數,(i,X)是長整數變數,
'xR是儲存格變數
Set xR = Range([B1], Cells(Rows.Count, "A").End(3))
'↑令xR這儲存格變數是 [B1]到A欄最後有內容儲存格,
'xR變數是此範圍的儲存格(物件)
Brr = xR
'↑令Brr這通用型變數是 二維陣列,
'以xR儲存格值帶入Brr陣列中
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
For i = 2 To UBound(Brr)
'↑設順迴圈!i從2到 Brr陣列縱向最大索引列號
Y(Brr(i, 2)) = "": Brr(i, 1) = i - 1
'↑令i迴圈列第2欄Brr陣列值當key,item是空字元,納入Y字典裡,
'令i迴圈列第1欄Brr陣列值是 i變數-1
Next
For X = 1 To Y.Count
'↑設順迴圈!i從1到 Y字典key數量數
For i = 2 To UBound(Brr): Y(Brr(i, 2)) = "": Next
'↑設順迴圈!i從2到 Brr陣列縱向最大索引列號,
'令i迴圈列第2欄Brr陣列值當key,item是空字元,納入Y字典裡
If Y.Exists(X) = Empty Then
'↑如果Y字典裡沒有X變數這key?
For i = 2 To UBound(Brr)
'↑設順迴圈!i從2到 Brr陣列縱向最大索引列號
If Brr(i, 2) > X Then Brr(i, 2) = Brr(i, 2) - 1
'↑如果i迴圈列第2欄Brr陣列值大於 X變數!
'就令i迴圈列第2欄Brr陣列值 -1
Next
X = X - 1
'↑令X變數 -1
End If
Y.RemoveAll
'↑令Y字典清空
Next
xR.Offset(, 3) = Brr
'↑令xR變數向右偏移3欄的範圍儲存格值以Brr陣列值帶入
Set Y = Nothing: Erase Brr: Set xR = Nothing
'↑令釋放變數
End Sub