请帮忙完善VBA编码，谢谢！

yearabc

Sub test()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
With Sheet1
    r = .Cells(Rows.Count, 3).End(xlUp).Row
    rs = .Cells(Rows.Count, 2).End(xlUp).Row
    If rs >= r Then
    ar = .Range("b4:b" & r)
    ReDim br(1 To 5)
    For i = UBound(ar) To 5 Step -1
        If Trim(ar(i, 1)) <> "" Then
            If Not d.exists(ar(i, 1)) Then
                n = n + 1
                If n > 5 Then Exit For
                br(n) = ar(i, 1)
                d(ar(i, 1)) = ""
            End If
        End If
    Next i
    .Cells(r + 1, 3).Resize(1, 5) = br
ElseIf rs < r Then
End If
End With
End Sub
请帮忙完善这个编码。附件是案例
把B列向上不同的5个数字排列在对应的下一行。这个VBA函数已经完成，但是目前是点击一下执行一次，如何才能一次把余下的一起执行。
还有同样的算法如何用一个编码把H列及类推数组包括进去。

yearabc

不要沉下去，大师帮忙啊！

psxk3535028-1

没有按你那个修改，另外写了一个，看看是否符合要求

yearabc

psxk3535028-1 发表于 2022-5-6 12:07
没有按你那个修改，另外写了一个，看看是否符合要求

谢谢，结果与我要求不一样。出现了空格

psxk3535028-1

yearabc 发表于 2022-5-6 22:26
谢谢，结果与我要求不一样。出现了空格

那就不知道你是什么要求了，不重复数字5个，还是5个去除重复，看你的例子不也是有不足5个的吗，如果连续5个数都一样，不就筛选出一个数字吗？理解不了，见谅