我正在尝试优化用于根据某些条件对列中的某些值求和的代码。我的列是A（PersonID），B（Firm）和C（ValuetoSum）。非常删节的版本可能如下所示：
A B C
1 BAML 100
1 HSBC 150
2 HSBC 110
4 CITI 150
5 HSBC 200
我想循环遍历B列中的每个公司，查找与其对应的所有人的ID，并将C列中与这些ID对应的所有值相加。因此，对于汇丰银行而言，代码将收集ID 1和4，然后汇总130 + 100 + 120 = 460.
我目前使用需要很长时间才能运行的多个循环和集合来执行此操作。过程如下：
对于每家公司 根据标准（公司和年份）创建PersonID的集合 根据人员ID和标准（年份）的集合创建一组值 求和第二个集合中的所有值 下一家公司
对于那些试图浏览下面代码的人：RP指的是一个人，这部分代码有兴趣找到趋势年（去年）的值。 TrendYearRPColl是Trend Year Research Partner Collection。
For i2 = 2 To LastRowUniqueClientList
ActiveFirm = Cells(i2, UniqueClientListColNum).Value
Set TrendYearRPColl = New Collection
For i3 = 2 To LastRow
If Cells(i3, DBFirmColNum).Value = ActiveFirm And Cells(i3, DBYearColNum).Value = TrendYear Then
TrendYearRPColl.Add Cells(i3, DBRespondentKeyColNum).Value
End If
Next i3
Set TrendYearMktShareColl = New Collection
For Each TrendYearRP In TrendYearRPColl
For i7 = 2 To LastRow
If Cells(i7, DBRespondentKeyColNum).Value = TrendYearRP And Cells(i7, DBYearColNum).Value = TrendYear Then
TrendYearMktShareColl.Add Cells(i7, DBMktShareVolColNum).Value
End If
Next i7
Next TrendYearRP
For Each TrendYearMktShare In TrendYearMktShareColl
TrendYearSum = TrendYearSum + TrendYearMktShare
Next TrendYearMktShare
我想知道是否有人认为将此操作转换为多个工作表函数以节省计算时间是值得的。如果它值得，我也非常感谢有关方向的建议。我已经整理了几个ws函数来完成这项工作，但它们需要添加和写入列，因为我不熟悉这些公式。
如果需要更好地解释任何事情，请告诉我，并感谢任何对此进行抨击的人。
-Steve
编辑显示460作为输出。
答案 0 :(得分：1)
史蒂夫的澄清后编辑： 啊，明白了......我想。因此，对于每个公司，您试图找到所有客户ID＆＃34;属于＆＃34;到那家公司然后加起来所有的价值＆＃34;与该客户端ID相关联，即使同一客户端ID再次出现，与另一家公司关联？是吗？
如果是这样，我认为您可以尝试以下方法：
此方法需要单次迭代才能读入所有数据。这种第一次迭代计算每个客户的总数，并确定每个公司和属于该公司的客户。然后，第二次迭代遍历每个公司的每个客户，以获得每个公司的总计。
因此，如果您有1000行信息和40家公司（假设每个公司平均有50个客户），那么您将看到1000个初始迭代和另外40个50 = 2000个迭代。第二组迭代实际上并不需要从电子表格中读取任何内容（这很慢）。希望这个aopproach更快。我实际上是在随机数据样本上尝试过这个。我有一百万行拥有大约1300家公司，它在不到40秒的时间内运行 - 所以它在一秒钟内完全处理了大约25,000行。 （我的电脑速度不快。）这对我来说似乎相当快，但我不确定你想要什么样的速度。
该方法的更详细概述如下：
A）循环输入并构建：
第二个集合的问题是你不能在集合中存储一个double类型（密钥是客户端ID），然后更改该值，至少不能直接更改。所以你不能做这样的事情：
ClientIDCln(ClientID) = ClientIDCln(ClientID) + CurrentRowValue
（其中ClientID是用于访问给定客户端的运行总计的密钥）
但是，如果您创建一个只有一个double类型的公共成员的小类，那么您可以添加ClientID集合，并在每次再次遇到客户端ID时更新该总计。所以你需要做这样的事情：
Dim NewEntry As New ClientRunningTotalClass
ClientIDCln.Add NewEntry, Key:=ClientID
ClientIDCln(ID).RunningTotal = ClientIDCln(ClientID).RunningTotal + Amount
B）你需要做的第二件事就是维护一个＆＃34;集合的集合＆＃34;。基本上你在＆＃34; master＆＃34;中创建了一个条目。每个唯一公司ID的集合。您在主集合中创建的条目是......一个新集合。此新集合是与该公司关联的客户ID的集合。所以在你的例子中，你会有像
这样的东西Master Collection Entries Contents for each collection within the master
BAML 1
HSBC 1, 2, 5
CITI 150
C）最后，当您运行数据时，您需要遍历主集合中的每个集合，并为每个客户端ID添加已计算的客户端总计。 （记住，您可以使用客户端ID访问在您的＆＃34;唯一客户端ID集合中查找该客户端的总数。：## 34;从步骤A开始。
要完成所有这些操作，您需要进行一些错误处理，因为您会发现当您更新集合时，项目在您需要它时不存在或者它已经存在当你想保留一份独特的清单时。
无论如何，我希望这会有所帮助。如果您需要更多细节，请大喊。
最后（虽然这应该是第一次），你使用Application.Screenupdating = FALSE吗？
当您将结果写入电子表格时？这可能会减慢很多东西。您还将计算模式设置为手动吗？ （只是检查！）
编辑2：好的，我已粘贴下面的代码 除此之外，您还需要添加一个Class模块（从Insert菜单中）并将其命名为ClientRunningTotalClass（使用F4调出属性并在那里重命名。） 这个课很简单 - 我在最后添加了代码。 （是的，它只包含两个声明！）
Option Explicit
'Takes a data where each row as a client ID, a firm ID and a total
'It then find all the clients of a particular firm and adds up the totals for those clients (including amounts for that client associated with otehr firms)
Sub SumAllClientAmountsForEveryFirm()
Dim ClientTotalCln As New Collection 'Collection of totals for each client (client ID used as key)
Dim FirmCln As New Collection 'Collection of firm ID's (really only needed to print out the FirmID)
Dim FirmClientListCln As New Collection 'Collection of collections! For each firm a collection object is added to this collection
Dim WS As Worksheet 'Worksheet for input and output
Dim inrow As Long 'current row of input
Dim currClientID As String 'current client ID that has just been read on
Dim currFirm As String 'current firm
Dim currAmount As Double 'current amount
Dim starttime As Double
starttime = Now()
'Loop through all the input rows to do the folloiwng
'1) Create a collection of client totals
'2) Create a collection of collections
' FirmClientListCln is a collection which itself contains a collections of client ID's (one collection for each firm)
' The first time the program comes across a new firm ID, it will add the firm ID to the FirmID collection
' _and_ create a new collection in FirmClientListCln. The client is added to the inner collection, as are any subsequent
' client ID's that are found for that particular firm
' Note that item number n in FirmCln and FirmClientListCln both refer to the same firm. FirmID is really only needed to
' keep a track of the firm's ID for printing out purposes.
Set WS = ThisWorkbook.Worksheets("Sheet1")
inrow = 5 'Assume first row of input starts in in row 5 (and column 1) of worksheet called "Sheet1"
Do While WS.Cells(inrow, 1) <> ""
currClientID = CStr(WS.Cells(inrow, 1))
currFirm = WS.Cells(inrow, 2)
currAmount = WS.Cells(inrow, 3)
Call CalcTotalForClientID(ClientTotalCln, currClientID, currAmount)
Call UpdateListOfFirmsAndTheirClients(FirmCln, FirmClientListCln, currClientID, currFirm)
inrow = inrow + 1
Loop
'Now dump the results
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'prevents workbook from recalculating each time a cell is changed
'For debugging only - spitting out total for each client. Although the client ID isn't tracked!
Dim i As Long, j As Long
Dim FirmTotal As Double
WS.Range("F4") = "Client ID"
WS.Range("G4") = "Client Total"
For i = 1 To ClientTotalCln.Count
WS.Cells(4 + i, 6) = ClientTotalCln(i).ClientID
WS.Cells(4 + i, 7) = ClientTotalCln(i).RunningTotal
Next
'Now dump totals for each firm
WS.Range("J4") = "Firm"
WS.Range("K4") = "Total for all clients"
For i = 1 To FirmCln.Count
WS.Cells(4 + i, 10) = FirmCln(i)
FirmTotal = 0
For j = 1 To FirmClientListCln(i).Count
WS.Cells(4 + i, 12 + j) = FirmClientListCln(i).Item(j) 'Debugging - uncomment this if you want to see the client ID's associated with a firm
FirmTotal = FirmTotal + ClientTotalCln(FirmClientListCln(i).Item(j)).RunningTotal
Next
WS.Cells(4 + i, 11) = FirmTotal
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
WS.Range("A3") = "Run time : " & Format(Now() - starttime, "hh:mm:ss")
End Sub
'Keeps a running total of Amount for each ClientID
Sub CalcTotalForClientID(ClientTotalCln As Collection, ClientID As String, Amount As Double)
'Try an increase the total for the current ClientID
'If a running total for the current ClientID hasn't already been started an error will be generated.
'Catch that error, create an entry for that client ID and then try and update the total again.
On Error GoTo ErrClientIDNotInCollection
ClientTotalCln(ClientID).RunningTotal = ClientTotalCln(ClientID).RunningTotal + Amount
On Error GoTo 0
Exit Sub
'Adds a new instance of a Running Total class to the ClientTotalCln, using the client ID as the
'key
ErrClientIDNotInCollection:
Dim NewEntry As New ClientRunningTotalClass 'Creates an instance of the clasee to add to the collection. (The "new" keyword is important!)
NewEntry.ClientID = ClientID
ClientTotalCln.Add NewEntry, Key:=CStr(ClientID)
Resume
End Sub
'Keeps a list of firms and the ClientID's belonging to each firm
Sub UpdateListOfFirmsAndTheirClients(FirmCln As Collection, FirmClientListCln As Collection, ClientID As String, Firm As String)
'Try and add a client ID to the firm
'This will generate an error if they firm doesn't exist OR
'if the client ID has already been added
On Error GoTo ErrFirmNotInCollection
FirmClientListCln(Firm).Add Item:=ClientID, Key:=ClientID
On Error GoTo 0
Exit Sub
ErrFirmNotInCollection:
Call AddIfFirmNotExists(FirmCln, FirmClientListCln, Firm, ClientID)
Resume Next
Exit Sub
End Sub
'Adds a new firm to the collection
'Note that we may reach here if the firm does already exist but the client ID has already been added.
'In that case, further errors will be generated and nothing will be done (which is what we want because we already have the client ID)
Sub AddIfFirmNotExists(FirmCln As Collection, FirmClientListCln As Collection, Firm, ClientID)
Dim ClientTotalCln As New Collection
On Error Resume Next
FirmCln.Add Item:=Firm, Key:=Firm
FirmClientListCln.Add Item:=ClientTotalCln, Key:=Firm
FirmClientListCln(Firm).Add Item:=ClientID, Key:=CStr(ClientID)
On Error GoTo 0
End Sub
ClientRunningTotalClass的代码
Option Explicit
'Maintains a running total for a single client.
Public RunningTotal As Double
Public ClientID As String 'Only for debugging (print out the Client ID alongside client total amount)
编辑3：使用Year处理第4列 我认为，对于包含年份的第四栏，您希望对待＆＃34; HSBC 2014＆＃34;作为一个完全不同的野兽来自＆＃34;汇丰2015＆＃34;同样＆＃34;客户1 2014＆＃34;作为来自＆＃34; Customer 1 2015＆＃34;的不同动物。如果是这样的话，我可以想到两个方法可以解决我的问题。第一种是按年预先分配数据，然后逐年处理。 （也就是说，一旦你有了新的一年，你就吐出我们的摘要并从下一个区块开始）。另一种方法是使用由Firm和Year组成的集合的密钥，例如＆＃34; HSBC | 2015＆＃34;同样，一个由ID和年份组成的客户ID，＆＃34; 1 | 2015＆＃34;您可能需要创建一个新类来保持公司和年份。 （新类将包含公司和年份作为字段）这是因为目前FirmCln只是直接添加了公司名称（您可以使用＆＃34; native＆＃34;类型数据，如int或double或字符串）。但是，如果要添加名称和年份，则可以创建一个类来存储它。或者您可以将它们连接成一个字符串，然后在将结果转储到Excel时拆分字符串。无论如何，这些只是一些想法 - 希望你能全力以赴。