­ã´£³¡ªL

Sub ±Æ¦W()
Dim Arr, Brr, xD, V&, i&, j&, k&, N&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([h1], [h1].Cells(Rows.Count, 1).End(3))
ReDim Brr(1 To UBound(Arr) + 1)
For i = 6 To UBound(Arr)
    If Arr(i, 1) = "" Then GoTo i01
    V = Arr(i, 1)
    If xD.Exists(V) Then GoTo i01 Else xD(V) = "": N = N + 1
    For j = N To 1 Step -1
        If V >= Brr(j) Then Brr(j + 1) = Brr(j) Else Exit For
    Next j
    Brr(j + 1) = V
i01: Next i
xD.removeall
For j = 1 To N: xD(Brr(j)) = j: Next
'------------------------------------
For i = 6 To UBound(Arr)
    V = xD(Arr(i, 1))
    If Arr(i, 1) = "" Then V = 0
    Arr(i - 5, 1) = V
Next i
[i6].Resize(UBound(Arr) - 5) = Arr
Set xD = Nothing: Erase Arr, Brr
End Sub


=====================================

­ã´£³¡ªL

¦^´_ 17# oak0723-1


Private Sub Worksheet_Change(ByVal Target As Range)
With Target
     If .Column <> [h1].Column Then Exit Sub
     If .Row < 6 Or .Count > 1 Then Exit Sub
     Call ±Æ¦Wtest02
End With
End Sub

¸ê®Æ¶q¤jªº¸Ü, ¤Ö¥Î¨Æ¥óIJµo, ¼Æ¾Ú§¹¦¨«á¥Î«ö¶s¸û¾A§´