samwang

¦^´_ 1# johnny1680


Sub test()
Dim R As Range, xD, n%
Set xD = CreateObject("Scripting.Dictionary")
For Each R In Range("a2:a101")
    n = n + 1
    If n = 5 Then
        If xD.exists(Cells(1, 1).Value) Then
        R.Value = xD(Cells(1, 1).Value) + 10
        xD(Cells(1, 1).Value) = R: n = 0
        Else
        R.Value = Cells(1, 1) + 10
        xD(Cells(1, 1).Value) = R: n = 0
        End If
    End If
Next
End Sub

samwang

¦^´_ 1# johnny1680

²¤Æ#2¡AÁÂÁÂ
Sub test2()
Dim Arr, xD
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range("a1:a101")
For i = 6 To UBound(Arr) Step 5
    If xD.Exists(Arr(1, 1)) Then
        Arr(i, 1) = xD(Arr(1, 1)) + 10
        xD(Arr(1, 1)) = Arr(i, 1)
    Else
        Arr(i, 1) = Arr(1, 1) + 10
        xD(Arr(1, 1)) = Arr(i, 1)
    End If
Next
Range("a1").Resize(UBound(Arr), 1) = Arr
End Sub