PROSAGA码农传奇-运筹学-在VBA中优化多个收集操作

<div class =“post-text”itemprop =“text”>
  
    史蒂夫，从你的例子中不清楚你想要什么。例如，与公司汇丰银行相关的PersonID是1,2＆amp; 5.如果我为这些ID添加了ValuetoSum，我得到100 + 150 + 110 + 200 = 470.你能澄清你的意思或我误解了什么吗？
你能澄清一下，“缓慢”有多慢，可接受的运行时间是多少？ （我不确定你是想要减速0.1秒，还是50秒就可以了。）此外，你还在使用多少条记录？
  
  
    史蒂夫澄清后编辑：
啊，明白了......我想。因此，对于每个公司，您试图找到所有客户ID“属于”该公司，然后将与该客户ID相关联的所有“值”相加，即使再次出现相同的客户ID，与另一家公司相关联？是对的吗？
  
  
    如果是这样，我认为您可以尝试以下方法：
  
  
    这种方法需要单次迭代才能读入所有数据。这种第一次迭代计算每个客户的总数，并确定每个公司和属于该公司的客户。然后，第二次迭代遍历每个公司的每个客户，以获得每个公司的总计。
  
  
    因此，如果您有1000行信息和40家公司（假设每个公司平均有50个客户），那么您将看到1000个初始迭代和另外40x50 = 2000个迭代。第二组迭代实际上并不需要从电子表格中读取任何内容（这很慢）。希望这个aopproach更快。我实际上是在随机数据样本上尝试过这个。我有一百万行拥有大约1300家公司，它在不到40秒的时间内运行 - 所以它在一秒钟内完全处理了大约25,000行。 （我的电脑不是很快。）这对我来说似乎相当快，但我不确定你在寻找什么样的速度。
  
  
    该方法的更详细概述如下：
  
  
    A）循环输入并构建：
  
  <OL>
    <LI>
      一系列独特的公司ID
    </LI>
    <LI>
      具有相关联的总计的唯一客户端ID的集合
客户端ID。 （因此在您的示例中，ID 1的总数将从100开始，然后在读入第二条记录后更新为250.）
    </LI>
  </醇>
  
    第二个集合的问题是您不能在集合中存储double类型（键是客户机ID），然后更改该值，至少不能直接更改。所以你不能做这样的事情：
  
   <pre>
 <code>
 ClientIDCln(ClientID) = ClientIDCln(ClientID) + CurrentRowValue

</code>
 </pre>
  
    （其中ClientID是用于访问给定客户端的运行总计的密钥）
  
  
    但是，如果您创建一个只有一个double类型的公共成员的小类，那么您可以添加ClientID集合，并在每次再次遇到客户端ID时更新该总计。所以你需要做这样的事情：
  
   <pre>
 <code>
 Dim NewEntry As New ClientRunningTotalClass
ClientIDCln.Add NewEntry, Key:=ClientID 
ClientIDCln(ID).RunningTotal = ClientIDCln(ClientID).RunningTotal + Amount

</code>
 </pre>
  
    B）在循环数据时需要做的第二件事是维护“集合集合”。基本上，您在每个唯一公司ID的“主”集合中创建一个条目。您在主集合中创建的条目是......一个新集合。此新集合是与该公司关联的客户端ID的集合。所以在你的例子中，你会有类似的东西
  
   <pre>
 <code>
 Master Collection Entries Contents for each collection within the master
BAML 1
HSBC 1, 2, 5
CITI 150

</code>
 </pre>
  
    C）最后，当您运行数据时，您需要遍历主集合中的每个集合，并为每个客户端ID添加已计算的客户端总计。 （记住，您可以使用客户端ID访问从步骤A中的“唯一客户端ID集合：”中查找该客户端的总数。
  
  
    要完成所有这些操作，您需要进行一些错误处理，因为您会发现当您更新集合时，如果您希望该项目不存在，或者当您尝试时它已经存在保持一个独特的清单。
  
  
    无论如何，我希望这有点帮助。如果您需要更多细节，请大喊
  
  
    最后（虽然这应该是第一次），你使用的是
     <code>
 Application.Screenupdating = FALSE
 </code>
    
当您将结果写入电子表格时？这可能会减慢很多东西。您还将计算模式设置为手动吗？ （只是检查！）
  
  
    编辑2：好的，我已粘贴下面的代码
除此之外，您还需要添加一个Class模块（从Insert菜单中）并将其命名为ClientRunningTotalClass（使用F4调出属性并在那里重命名。）
这个类非常简单 - 我在最后添加了代码。 （是的，它只包含两个声明！）
  
   <pre>
 <code>
 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

</code>
 </pre>
  
    ClientRunningTotalClass的代码
  
   <pre>
 <code>
 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)

</code>
 </pre>
  
    编辑3：使用Year处理第4列
我认为是的第四列包含年份，您希望将“HSBC 2014”视为与“HSBC 2015”完全不同的野兽，同样将“Customer 1 2014”视为与“Customer 1 2015”不同的动物。如果是这样的话，我可以想到两个方法可以解决。第一种是按年预先分配数据，然后逐年处理。 （也就是说，一旦你有了新的一年，你就吐出我们的摘要并从下一个区块开始）。另一种方法是使用由Firm和Year组成的集合的密钥，例如“HSBC | 2015”以及同样包含ID和年份的客户ID，“1 | 2015”您可能需要创建一个新的类来保持公司和年份。 （新类将包含Firm和year作为字段）这是因为当前FirmCln只是直接添加了Firm名称（您可以使用“本机”类型数据（如int或double或string）执行此操作）。但是，如果要添加名称和年份，则可以创建一个类来存储它。或者您可以将它们连接成一个字符串，然后在将结果转储到Excel时拆分字符串。无论如何，这些只是一些想法 - 希望你能全力以赴。
  
</DIV>