|
本帖最后由 Datous 于 2019-3-23 09:02 编辑
用代码做的。
Sub PartRank()
Dim vntValues, lngCnt As Long, lngRank() As Long
Dim lngPartLeft As Long, lngPartRight As Long, blnPartEnd As Boolean
Dim A, B, C
vntValues = Range("G2:G" & Range("G30000").End(xlUp).Row)
lngCnt = UBound(vntValues)
ReDim lngRank(1 To lngCnt)
lngPartLeft = 1
While lngPartRight < lngCnt
Do
A = A + 1
If A + 1 = lngCnt Then
A = A + 1
Exit Do
End If
If PartNo(vntValues(A, 1)) <> PartNo(vntValues(A + 1, 1)) _
Or (vntValues(A, 1) < vntValues(A + 1, 1)) Then blnPartEnd = True
Loop Until blnPartEnd
lngPartRight = A
C = 1
For B = lngPartLeft To lngPartRight
lngRank(B) = C
C = C + 1
Next
lngPartLeft = lngPartRight + 1
blnPartEnd = False
Wend
Range("H2").Resize(lngCnt) = Application.WorksheetFunction.Transpose(lngRank)
End Sub
Function PartNo(vntValue) As Byte
Dim bytPart As Byte
If vntValue >= 50000 Then
bytPart = 3
ElseIf vntValue >= 10000 Then
bytPart = 2
Else
bytPart = 1
End If
PartNo = bytPart
End Function
|
评分
-
1
查看全部评分
-
|