Question

以下问题困扰了我很长一段时间。

我使用以下公式对收入（范围B2：B10）进行排名，以年份为条件（范围A2：A10）：

=SUMPRODUCT(($A$2:$A$10=A10)*($B$2:$B$10>B10))+1

我将此公式粘贴到范围（C2：C10）中以查找每个观察的等级。

这一切都很好，但是，这里有一个问题：我需要做的不是10次观测，而是124440次观测;这样做会使我的工作簿瘫痪一段时间。

所以我的问题是：你能帮我找到一种方法，它允许我计算上面提到的公式，而不必在每个单元格中复制/粘贴它（可能通过使用VBA），这反过来将允许计算跑得快得多？

我已经浏览过网络，但由于我是VBA的新手，我还没有弄清楚我应该寻找什么

Company Name               Year - Fiscal    Revenues    Rank
AAR CORP                   2003             150         1
AAR CORP                   2004             180         1
AAR CORP                   2005             120         2
ADC TELECOMMUNICATIONS INC 2003             90          3
ADC TELECOMMUNICATIONS INC 2004             99          3
ADC TELECOMMUNICATIONS INC 2005             108         3
AFP IMAGING CORP           2003             120         2
AFP IMAGING CORP           2004             130         2
AFP IMAGING CORP           2005             140         1

根据您的要求。而不是10个观察结果，而不是124440。

Answer 1

这不是VBA解决方案，而是替代公式。

用

ColumnA为 CompanyName ， ColumnB为年， ColumnC为收入， ColumnD为排名

首先，对数据进行排序

（B栏）
然后由收入（C栏）

在Rank栏上，

表示第一行数据，键入1作为排名。
对于第二行数据，键入此公式： =IF(B3=B2,D2 + 1, 1)

公式说：

if the year is the same increase the rank number by 1 else reset the rank as 1

向下拖动公式。

公式计算得很快我认为但是为了保留指定的等级，你需要复制和选择特殊粘贴，只需要值，用一个值替换公式。这种方式，如果您决定对整个表进行排序，您将不会失去排名

Answer 2

不知道你们中有多少人仍然关注这篇文章。但是对于完全披露，这正是我所寻求的并且要快得多（在2分钟而不是15分钟内完成124000障碍的工作）：

Sub Rank()

    Dim LastRow         As Long
    Dim LastCol         As Long

    Application.ScreenUpdating = False

    ThisWorkbook.Sheets("Sheet2").Select

    LastRow = Cells(Rows.Count, "B").End(xlUp).Row

    With ActiveSheet.UsedRange
        LastCol = .Columns.Count + .Columns(1).Column - 1
    End With

    'Create a temporary column so that it can be used to re-sort data to its original state
    Cells(2, LastCol + 1).Value = 1
    Cells(3, LastCol + 1).Value = 2
    Cells(2, LastCol + 1).Resize(2).AutoFill Range(Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1))

    'Sort the data by Column B, in ascending order
    Range("A1", Cells(LastRow, LastCol + 1)).Sort key1:=Range("B1"), order1:=xlAscending, _
        Header:=xlYes, ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

    'Select B2 prior to creating a dynamic named range, since it uses relative references
    Range("B2").Select

    'Create the dynamic named range
    ThisWorkbook.Names.Add "MyDynRng", "=INDEX(R2C2:R" & LastRow & "C2,MATCH(RC2,R2C2:R" & _
        LastRow & "C2,0)):INDEX(R2C6:R" & LastRow & "C6,MATCH(RC2,R2C2:R" & LastRow & "C2,1))"

    'Put the header for the ranking column
    Cells(1, LastCol + 2).Value = "Rank"

    'Enter the ranking formula and convert them to values
    With Range(Cells(2, LastCol + 2), Cells(LastRow, LastCol + 2))
        .FormulaR1C1 = "=COUNTIFS(INDEX(MyDynRng,0,1),RC2,INDEX(MyDynRng,0,5),"">""&RC6)+1"
        .Value = .Value
    End With

    'Re-sort the data to its original state
    Range("A1", Cells(LastRow, LastCol + 2)).Sort key1:=Cells(1, LastCol + 1), order1:=xlAscending, _
        Header:=xlYes, ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

    'Delete the defined name
    ThisWorkbook.Names("MyDynRng").Delete

    'Delete the temporary column
    Cells(1, LastCol + 1).EntireColumn.Delete

    'To change the Lookup Column, adjust column numbers in the dynamic range (For example C5 to C6 if you want to go from column E to F

    Application.ScreenUpdating = True


End Sub

这是由一个叫Domenic的家伙向我建议的。不知道他是否在Stackoverflow上活跃，但如果他是，请感谢伙计。

Sumproduct VBA而不是公式

2 个答案: