實現功能：
銷售數據在全局排名、在相同子類（可以是區域、分類）再對銷售進行各自排名
k列(11)爲銷售數據，A列爲子類，全局排名數據存放到第15列，子類排名存放到第14列
可以對A、K列設爲變量再賦值，提高代碼移植的便利性
Sub SalesSeqence()
'
' seqence Macro
' 宏由 mike 錄製
'
Dim RowN As Integer
Dim i As Integer
Dim colqA as integer,colqK as integer '2個參照數據列數
Dim colA as integer '全局排名填充列
Dim colB as integer '子類排名填充列
colqA=1
colqK=11
colA=15
colB=14
'獲取數據行數,減少後面的循環次數
For i = 1 To 20000
If Cells(i, colqK).Value <> "" Then
RowN = i
End If
Next i
'子類不全時填充全--數據特殊格式可以略過
For i = 3 To RowN
If Cells(i, colqK).Value <> "" And Cells(i, colqA) = "" Then
Cells(i,colqA) = Cells(i - 1, colqA)
End If
Next i
'---------------------進行全局排名
Columns("K:K").Select
Range("A1:O" & RowN).Sort Key1:=Range("K1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
'第一遍遍歷
Cells(2, colA).Value = 1
For i = 3 To RowN
If Cells(i, colqK).Value <> "" Then
Cells(i, colA).Value = Cells(i - 1, colA).Value + 1
End If
Next i
'第二遍合併相同名次
For i = 3 To RowN
If Cells(i, colqK).Value <> "" And Cells(i,colqK).Value = Cells(i - 1,colqK).Value Then
Cells(i, colA).Value = Cells(i - 1, colA).Value
End If
Next i
'----------------在子類進行排名
Columns("k:k").Select
Range("A1:O" & RowN).Sort Key1:=Range("k1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
Columns("A:A").Select
Range("A1:O" & RowN).Sort Key1:=Range("A1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
Cells(2, colB).Value = 1
For i = 3 To RowN
If Cells(i, colqK).Value <> "" And Cells(i, colqA).Value = Cells(i - 1,colqA).Value Then
Cells(i, colB).Value = Cells(i - 1, colB).Value + 1
ElseIf Cells(i, colqK).Value <> "" And Cells(i, colqA).Value <> Cells(i - 1, colqA).Value Then
Cells(i, colB).Value = 1
End If
Next i
For i = 3 To RowN
If Cells(i, colqK).Value <> "" And Cells(i, colqA).Value = Cells(i - 1, colqA).Value And Cells(i, colqK).Value = Cells(i - 1, colqK).Value Then
Cells(i, colB).Value = Cells(i - 1, colB).Value
End If
Next i
End Sub