samwang

¦^´_ 5# oak0723-1

1.«e«á³£¦³¼Æ¾ÚªºªÅ¥ÕÀx¦s®æ-->Åã¥Ü0,¤£¦C¤J±Æ¦W
2.¼Æ¾Úµ²§ô«áªºªÅ¥ÕÀx¦s®æ-->¤£¦C¤J±Æ¦W,¤£§@°Ê§@,¨ÌµM¬OªÅ¥Õ
>> 3#µ{¦¡¦³²Å¦X¤W­z±ø¥ó¡AÁÂÁÂ

samwang

¦^´_ 1# oak0723-1

¤£¤@¼Ëªº¸Ñªk¦³¤ñ3#¦A´£¤É¤@ÂIÂI®Ä²v¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub test2()
Dim Arr, xD, a, T, i&
Set xD = CreateObject("Scripting.Dictionary")
Tm = Timer
Arr = Range("h6:h" & Cells(Rows.Count, 8).End(xlUp).Row)
For i = 1 To UBound(Arr)
    T = Arr(i, 1): If T <> "" Then xD(T) = ""
Next
For i = 1 To xD.Count
    a = Application.Large(xD.keys, i)
    n = n + 1: xD(a) = n
Next
For i = 1 To UBound(Arr)
    T = Arr(i, 1)
    If T = "" Then Arr(i, 1) = 0: GoTo 99
    Arr(i, 1) = xD(T)
99: Next
Range("j6").Resize(UBound(Arr)) = Arr
MsgBox Timer - Tm
End Sub

­ã´£³¡ª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


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

oak0723-1

¦^´_ 13# ­ã´£³¡ªL


    ÁÂÁÂÃöª`
·PÁ¼ö¤ß¦^´_

oak0723-1

¦^´_ 12# samwang


    ½T¹ê³t«×¦³Åܱo§ó§Ö
«D±`·PÁÂ
¹ï§ÚÀ°§U«D±`¤j

oak0723-1

¦^´_ 11# samwang


    ¬Oªº
³£¦³²Å¦X
¦]¬°µo²{®É¤å³¹¤w¶W¹L15¤ÀÄÁ
µLªk§R°£
©Ò¥H«Ü¹ï¤£°_

oak0723-1

¦^´_ 13# ­ã´£³¡ªL


    ·Q§Q¥Î¨Æ¥óIJµo±Æ¦W¥¨¶°
·í H Ä椺®e§ïÅÜ´NIJµo°õ¦æ"±Æ¦Wteat02"¥¨¶°
¦p¦ó¨Ï¥Î¨Æ¥óIJµo?
­Y¤£¥Î¨Æ¥óIJµo,­n¦p¦óIJµo?

­ã´£³¡ª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§´

oak0723-1

¦^´_ 18# ­ã´£³¡ªL


    ÁÂÁ§A

ML089

'°Ñ¦Ò ikboy ¾Ç²ßSystem.collections.arraylist
Sub ±Æ¦WAmoKat­×§ï()
    tm = Timer
    Dim d As Object, a, k, t, xL As Object, n&
   
    a = Range("h6:h" & [h1048576].End(3).Row)
   
    Set d = CreateObject("scripting.dictionary") '¦r¨å¨ú°ß¤@­È
    For Each k In a: If k <> "" Then d(k) = 0: Next
   
    Set xL = CreateObject("System.collections.arraylist") '±Æ§Ç§@·~
    For Each k In d.keys: xL.Add k: Next
    xL.Sort     'Sorted Ascending
    xL.Reverse  'Reverse sort
    For i = 1 To xL.Count: d(xL(i - 1)) = i: Next '±Æ§Ç§Ç¸¹(±Æ¦W)¼g¤J¦r¨å
   
    For i = 1 To UBound(a)
        If a(i, 1) = "" Then a(i, 1) = 0 Else a(i, 1) = d(a(i, 1)) '±Æ¦W¼g¤Ja°}¦C
    Next
    [i6].Resize(UBound(a)) = a 'a°}¦C¼g¤J I Äæ¦ì
    Debug.Print Timer - tm, "End"  '31.40" §ïµ½¬° 0.332"
End Sub