¤j¶q¸ê®Æ±Æ¦W

oak0723-1

¦U¦ì¥ý¶i¦n
§Ú·Q­n§âHÄæ¦ì¸Ì±Æ¦WÅã¥Ü¦bJÄæ
¦ý¦]¬°¸ê®Æ¤Ó¦h±`±`·|¦³¹F50¸U­Ó¼Æ¦r(¸ê®Æ¼Æ¤£¤@©w)
¥Î¨ç¼Æ¤è¦¡³B²z±`±`·|·í±¼
¤£ª¾¦p¦ó§ï¦¨VBAªº¤è¦¡¦Û°Ê­pºâ
¨ç¼Æ¦¡:"=IF(H6="",0,SUMPRODUCT(($H$6:$H$500000>=H6)*(1/COUNTIF(H$6:H$500000,H$6:H$500000))))"

ML089

10¸Uµ§¸ê®Æ¡A°ß¤@­È¦³1¸Uµ§¡A±Æ¦W¤ñ¸û
±Æ§Ç±Ä¥Î Range.Sort   °õ¦æ®É¶¡  0.3"
±Æ§Ç±Ä¥Î System.collections.arraylist    °õ¦æ®É¶¡  0.33"
±Æ§Ç±Ä¥Î Large¨ç¼Æ °õ¦æ®É¶¡ 30"
µ²½× Range.Sort ¤]¤£ºC

­ì¸ê®Æ10¸Uµ§¥u¦³6µ§¬O°ß¤@­È¡A³o¼Ë´ú¤£¥X®Ä²v¡A
¨ä¹ê°ß¤@­È¤p©ó10µ§¥Î¨ç¼Æ¤]¥i¥H 0.3"¡A°ß¤@­È¬°1¸Uµ§»Ý­n46¬í

Sub ±Æ¦WAmoKat()
    tm = Timer
    Set xD = CreateObject("Scripting.Dictionary")
    Arr = Range([h6], [h1].Cells(Rows.Count, 1).End(xlUp))
    For i = 1 To UBound(Arr): xD(Arr(i, 1)) = 0: Next i '¦r¨å²£¥Í°ß¤@­È
    With [i6].Resize(xD.Count) '§Q¥Î Range.Sort ±Æ§Ç
        .Value = Application.Transpose(xD.keys)
        .Sort Key1:=.Item(1), Order1:=xlDescending, Header:=xlNo
    End With
    For i = 1 To xD.Count: xD(Cells(5 + i, "I").Value) = i: Next i '±Æ§Ç§Ç¸¹¼g¤J¦r¨å
    For i = 1 To UBound(Arr)    '¬d¸ß¦r¨å±Æ¦C§Ç¸¹
        If Arr(i, 1) = "" Then Arr(i, 1) = 0 Else Arr(i, 1) = xD(Arr(i, 1))
    Next i
    [i6].Resize(UBound(Arr)) = Arr '¶K¤W¸ê®Æ
    Set xD = Nothing: Erase Arr
    Debug.Print Timer - tm    '0.30"
End Sub

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

oak0723-1

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


    ÁÂÁ§A

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

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


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

oak0723-1

¦^´_ 11# samwang


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

oak0723-1

¦^´_ 12# samwang


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

oak0723-1

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


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

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


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