Sumproduct VBA而不是公式

Question

以下问题困扰了我好久。

我使用以下公式根据年份（范围 A2:A10）对收入（范围 B2:B10）进行排名：

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

我将此公式粘贴到 Range(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 作为排名

首先，对数据进行排序

1. 按年份（B 列）
2. 然后按收入（C 列）

在排名列上，

1. 对于第一行数据，键入 1 作为排名。
2. 对于第二行数据，键入以下公式： =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 obs 的工作）：

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 上活跃，如果是，谢谢哥们。