在 VBA 中优化多个集合操作
Optimizing Multiple Collection operations in VBA
我正在尝试优化我用来根据某些条件对列中的某些值求和的代码。我的列是 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 函数放在一起来完成这项工作，但它们需要添加和写入列，因为我不太熟悉这些公式。
如果有任何需要更好地解释的地方，请告诉我，感谢任何为此付出努力的人。
-史蒂夫
已编辑以显示 460 作为输出。
史蒂夫，从你的例子中并不清楚你想要什么。例如，与 Firm HSBC 关联的 PersonID 是 1,2 & 5。如果我将这些 ID 的 ValuetoSum 相加，我得到 100+150+110+200 = 470。你能澄清你的意思或我的误解吗？
您能否也澄清一下，"slow" 有多慢以及可接受的 运行 时间是多少？ （我不确定您是希望 0.1 秒变慢，还是 50 秒就可以。）另外，您要处理多少条记录？
史蒂夫澄清后编辑：
啊，明白了……我想。因此，对于每个公司，您都试图找到该公司的所有客户 ID "belonging"，然后将与该客户 ID 关联的所有 "values" 相加，即使再次出现与另一家公司关联的相同客户 ID ？是吗？
如果是这样，我想你可以试试下面的方法：
这种方法需要单次迭代来读入所有数据。这第一次迭代计算每个客户的总数，并确定每个公司和属于该公司的客户。然后，第二次迭代遍历每个公司的每个客户，以获得每个公司的 g运行d 总数。
因此，如果您有 1000 行信息和 40 家公司（假设每家公司平均有 50 位客户），您将查看 1000 次初始迭代和进一步的 40x50 = 2000 次迭代。第二组迭代实际上不需要从电子表格中读取任何内容（这非常慢）。希望这种方法更快。我实际上在 运行dom 数据样本上尝试过这个。我有大约 1300 家公司的一百万行，它 运行 在不到 40 秒的时间内完成 - 所以它在一秒钟内完全处理了大约 25,000 行。 （我的电脑速度不快。）这对我来说似乎相当快，但我不确定您正在寻找什么样的速度。
更详细的方法概述如下：
A) 循环输入并建立：
- 一个 collection 个唯一的公司 ID
- 一个 collection 个唯一的客户 ID 以及相关的总计
该客户端 ID。 （因此，在您的示例中，ID 1 的总数将从 100 开始，然后在读入第二条记录后更新为 250。）
第二个 collection 的问题是您不能在 collection 中存储双精度类型（键是客户端 ID）然后更改该值，至少不能直接地。所以你不能这样做：
ClientIDCln(ClientID) = ClientIDCln(ClientID) + CurrentRowValue
（其中 ClientID 是用于访问给定客户端的 运行ning 总数的密钥）
但是，如果您改为创建一个只有一个 public 双精度类型成员的小型 Class，那么您可以添加 ClientID collection 并更新每个总数当您再次遇到客户端 ID 时。所以你需要做这样的事情：
Dim NewEntry As New ClientRunningTotalClass
ClientIDCln.Add NewEntry, Key:=ClientID
ClientIDCln(ID).RunningTotal = ClientIDCln(ClientID).RunningTotal + Amount
B) 在循环遍历数据时需要做的第二件事是维护 "collection of collections"。基本上，您在 "master" collection 中为每个唯一的公司 ID 创建一个条目。您在 master collection 中创建的条目是...一个新的 collection。这个新 collection 是与该公司关联的客户 ID 的 collection。所以在你的例子中，你会有类似
Master Collection Entries Contents for each collection within the master
BAML 1
HSBC 1, 2, 5
CITI 150
C) 最后，当您 运行 通过您的数据时，您将需要循环遍历主 collection 中的每个 collection，并将已经计算的客户端总数相加对于每个客户端 ID。 （请记住，您可以使用客户 ID 在步骤 A."unique client ID collection.:" 中找到该客户的总数。
要完成所有这些操作，您需要进行一些错误处理，因为您会发现，当您更新 collections 时，您想要的项目不存在或者当您尝试保留唯一列表时它已经存在。
总之，希望对您有所帮助。如果您需要更多详细信息，请大声说出来。
最后（虽然也许这应该是第一个），你在使用 Application.Screenupdating = FALSE
当您将结果写入电子表格时？这会减慢很多事情。您是否也将计算模式设置为手动？ （只是检查！）
编辑 2：好的，我粘贴了下面的代码
除此之外，您还需要添加一个 Class 模块（从“插入”菜单中）并将其命名为 ClientRunningTotalClass（使用 F4 调出属性并在此处重命名。）
class 非常简单 - 我在最后添加了代码。 （是的，它只包含两个声明！）
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
ClientRunningTotal 代码Class
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：处理带有年份的第 4 列
我假设对于包含年份的第四列，您希望将 "HSBC 2014" 视为与 "HSBC 2015" 完全不同的野兽，同样地，将 "Customer 1 2014" 视为与 "Customer 1 2015" 不同的动物。如果是这样，我可以想到两种可行的方法。首先是按年预排序数据，然后按年分块处理。 （即，一旦你开始与新年保持一致，你就会吐出我们的摘要并从下一个块开始）。另一个应该是使用由 Firm 和 Year 组成的 collection 的键，例如"HSBC|2015" 以及同样由 ID 和年份组成的客户 ID，“1|2015” 您可能需要创建一个新的 class 来保留公司和年份。 （新的 class 将同时包含公司和年份字段）这是因为目前 FirmCln 只是将公司名称直接添加到其中（您可以使用 "native" 类型的数据（例如 int 或双精度或字符串）。但是，如果您想添加名称和年份，您可以创建一个 class 来存储它。或者您可以将它们连接成一个字符串，然后在将结果转储到 Excel 中时拆分该字符串。不管怎样，这些只是一些想法 - 希望你能顺利完成。
我正在尝试优化我用来根据某些条件对列中的某些值求和的代码。我的列是 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 函数放在一起来完成这项工作，但它们需要添加和写入列，因为我不太熟悉这些公式。
如果有任何需要更好地解释的地方，请告诉我，感谢任何为此付出努力的人。
-史蒂夫
已编辑以显示 460 作为输出。
史蒂夫，从你的例子中并不清楚你想要什么。例如，与 Firm HSBC 关联的 PersonID 是 1,2 & 5。如果我将这些 ID 的 ValuetoSum 相加，我得到 100+150+110+200 = 470。你能澄清你的意思或我的误解吗？ 您能否也澄清一下，"slow" 有多慢以及可接受的 运行 时间是多少？ （我不确定您是希望 0.1 秒变慢，还是 50 秒就可以。）另外，您要处理多少条记录？
史蒂夫澄清后编辑： 啊，明白了……我想。因此，对于每个公司，您都试图找到该公司的所有客户 ID "belonging"，然后将与该客户 ID 关联的所有 "values" 相加，即使再次出现与另一家公司关联的相同客户 ID ？是吗？
如果是这样，我想你可以试试下面的方法：
这种方法需要单次迭代来读入所有数据。这第一次迭代计算每个客户的总数，并确定每个公司和属于该公司的客户。然后，第二次迭代遍历每个公司的每个客户，以获得每个公司的 g运行d 总数。
因此，如果您有 1000 行信息和 40 家公司（假设每家公司平均有 50 位客户），您将查看 1000 次初始迭代和进一步的 40x50 = 2000 次迭代。第二组迭代实际上不需要从电子表格中读取任何内容（这非常慢）。希望这种方法更快。我实际上在 运行dom 数据样本上尝试过这个。我有大约 1300 家公司的一百万行，它 运行 在不到 40 秒的时间内完成 - 所以它在一秒钟内完全处理了大约 25,000 行。 （我的电脑速度不快。）这对我来说似乎相当快，但我不确定您正在寻找什么样的速度。
更详细的方法概述如下：
A) 循环输入并建立：
- 一个 collection 个唯一的公司 ID
- 一个 collection 个唯一的客户 ID 以及相关的总计 该客户端 ID。 （因此，在您的示例中，ID 1 的总数将从 100 开始，然后在读入第二条记录后更新为 250。）
第二个 collection 的问题是您不能在 collection 中存储双精度类型（键是客户端 ID）然后更改该值，至少不能直接地。所以你不能这样做：
ClientIDCln(ClientID) = ClientIDCln(ClientID) + CurrentRowValue
（其中 ClientID 是用于访问给定客户端的 运行ning 总数的密钥）
但是，如果您改为创建一个只有一个 public 双精度类型成员的小型 Class，那么您可以添加 ClientID collection 并更新每个总数当您再次遇到客户端 ID 时。所以你需要做这样的事情：
Dim NewEntry As New ClientRunningTotalClass
ClientIDCln.Add NewEntry, Key:=ClientID
ClientIDCln(ID).RunningTotal = ClientIDCln(ClientID).RunningTotal + Amount
B) 在循环遍历数据时需要做的第二件事是维护 "collection of collections"。基本上，您在 "master" collection 中为每个唯一的公司 ID 创建一个条目。您在 master collection 中创建的条目是...一个新的 collection。这个新 collection 是与该公司关联的客户 ID 的 collection。所以在你的例子中，你会有类似
Master Collection Entries Contents for each collection within the master
BAML 1
HSBC 1, 2, 5
CITI 150
C) 最后，当您 运行 通过您的数据时，您将需要循环遍历主 collection 中的每个 collection，并将已经计算的客户端总数相加对于每个客户端 ID。 （请记住，您可以使用客户 ID 在步骤 A."unique client ID collection.:" 中找到该客户的总数。
要完成所有这些操作，您需要进行一些错误处理，因为您会发现，当您更新 collections 时，您想要的项目不存在或者当您尝试保留唯一列表时它已经存在。
总之，希望对您有所帮助。如果您需要更多详细信息，请大声说出来。
最后（虽然也许这应该是第一个），你在使用 Application.Screenupdating = FALSE
当您将结果写入电子表格时？这会减慢很多事情。您是否也将计算模式设置为手动？ （只是检查！）
编辑 2：好的，我粘贴了下面的代码 除此之外，您还需要添加一个 Class 模块（从“插入”菜单中）并将其命名为 ClientRunningTotalClass（使用 F4 调出属性并在此处重命名。） class 非常简单 - 我在最后添加了代码。 （是的，它只包含两个声明！）
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
ClientRunningTotal 代码Class
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：处理带有年份的第 4 列 我假设对于包含年份的第四列，您希望将 "HSBC 2014" 视为与 "HSBC 2015" 完全不同的野兽，同样地，将 "Customer 1 2014" 视为与 "Customer 1 2015" 不同的动物。如果是这样，我可以想到两种可行的方法。首先是按年预排序数据，然后按年分块处理。 （即，一旦你开始与新年保持一致，你就会吐出我们的摘要并从下一个块开始）。另一个应该是使用由 Firm 和 Year 组成的 collection 的键，例如"HSBC|2015" 以及同样由 ID 和年份组成的客户 ID，“1|2015” 您可能需要创建一个新的 class 来保留公司和年份。 （新的 class 将同时包含公司和年份字段）这是因为目前 FirmCln 只是将公司名称直接添加到其中（您可以使用 "native" 类型的数据（例如 int 或双精度或字符串）。但是，如果您想添加名称和年份，您可以创建一个 class 来存储它。或者您可以将它们连接成一个字符串，然后在将结果转储到 Excel 中时拆分该字符串。不管怎样，这些只是一些想法 - 希望你能顺利完成。