更新存储在该字典

Question

集合的一个字典条目是可能比较容易通过展示第一，然后我的期望输出一些样本数据来解释这个问题。

我有一个看起来像这样的表：

Date  Agent Case # Minutes 
12/1/2016 Mary  6  15 
12/2/2016 Joe   5  34 'Not a typo, records are NOT sorted by date 
12/1/2016 Bob  20  10 
12/2/2016 Mary  17  11 
12/2/2016 Mary  7  9 
12/2/2016 Bob  17  24 
12/3/2016 Bob   1  47 
12/3/2016 Joe   9  20 
12/3/2016 Mary  12  6 
12/3/2016 Joe   9  10 
12/3/2016 Joe   6  22 

我需要的输出看起来像这样：

Date  Agent Count Case Count  Minutes 
12/1/2016  2    2    25 
12/2/2016  3    3    78 
12/3/2016  3    4    105 

代理计数是唯一的代理商总数和病例数是当天唯一病例总数。分钟只是当天所有分钟的总和。如果没有对几个现有程序进行重大修改，记录就无法按日期排序。

我的这种做法是创建日期与该项目作为3个希望输出的集合键的字典。然后，集合将包含名称字典，案例字典和总计分钟。这是我使用来实现，代码：

Private Sub CreateSummarySheet() 
    Dim dtDay As Date 
    Dim rAllData As Long 'Row on all data 
    Dim rSummary As Long 'Row on Summary 
    Dim intMinutes As Long 'Minute total 
    Dim wsSummary As Worksheet 
    Dim wsAllData As Worksheet 
    Dim dicCases As Object 'Dictionary of Cases 
    Dim dicAgents As Object 'Dictionary of people 
    Dim dicDates As Dictionary ' Object 'Dictionary of dates 
    Dim colDateData As Collection 
    Dim key As Variant 

    Set wsAllData = ThisWorkbook.Worksheets("All Data") 
    Set wsSummary = ThisWorkbook.Worksheets("Summary Page") 
    Set dicDates = CreateObject("Scripting.Dictionary") 

    rAllData = 2 

    'Loop through All Data until the end of the list 
    While wsAllData.Cells(rAllData, 1).Value <> "" 
     dtDay = wsAllData.Cells(rAllData, 2).Value 

     'Is the date in our collection? 
     If Not dicDates.Exists(dtDay) Then 
      'Create a new collection for this day and add it to the dictionary 
      Set colDateData = New Collection 
      Set dicAgentss = CreateObject("Scripting.Dictionary") 
      Set dicCases = CreateObject("Scripting.Dictionary") 
      colDateData.Add 0, "Minutes" 
      colDateData.Add dicAgents, "Names" 
      colDateData.Add dicCases, "Cases" 
      dicDates.Add dtDay, colDateData 
     End If 

     'Get this day's collection 
     Set colDateData = dicDates.Item(dtDay) 
     'Total the minutes 
     intMinutes = colDateData.Item("Minutes") + wsAllData.Cells(rAllData, 3).Value 
     colDateData.Remove "Minutes" 
     colDateData.Add intMinutes, "Minutes" 
     'Add unique names 
     Set dicAgents = colDateData.Item("Names") 
     If Not dicAgents.Exists(wsAllData.Cells(rAllData, 4).Value) Then 
      dicAgents.Add _ 
       wsAllData.Cells(rAllData, 4).Value, wsAllData.Cells(rAllData, 4).Value 
      colDateData.Remove "Names" 
      colDateData.Add dicAgents, "Names" 
     End If 
     'Add unique Cases 
     If Len(wsAllData.Cells(rAllData, 5).Value) = 15 And _ 
      IsNumeric(wsAllData.Cells(rAllData, 5).Value) Then 
      'Looks like a Case so add it if it doesn't already exist 
      Set dicCases = colDateData.Item("Cases") 
      If Not dicCases.Exists(wsAllData.Cells(rAllData, 5).Value) Then 
       dicCases.Add _ 
        wsAllData.Cells(rAllData, 5).Value, wsAllData.Cells(rAllData, 5).Value 
       colDateData.Remove "Cases" 
       colDateData.Add dicCases, "Cases" 
      End If 
     End If 

     'put the collection back in the dictionary 
     dicDates.Item(dtDay) = colDateData 
     rAllData = rAllData + 1 
    Wend 

    'Find the first blank row on the summary page 
    rSummary = 2 
    While wsSummary.Cells(rSummary, 1).Value <> "" 
     rSummary = rSummary + 1 
    Wend 

    'Loop through the dictionary of dates to output the data 
    For Each key In dicDates.Keys 'dtDate is the key 
     Set colDateData = dicDates(key) 
     Set dicAgents = colDateData.Item("Names") 
     Set dicCases = colDateData.Item("Cases") 
     With wsSummary 
      .Cells(rSummary, 1).Value = key 'Date 
      .Cells(rSummary, 2).Value = dicAgents.Count 'Total Unique Agents 
      .Cells(rSummary, 3).Value = colDateData.Item("Minutes") 'Total Minutes 
      .Cells(rSummary, 7).Value = dicCases.Count 'Total Unique Cases 
     End With 
     rSummary = rSummary + 1 
    Next 

    Set wsSummary = Nothing 
    Set wsAllData = Nothing 
    Set dicCases = Nothing 
    Set dicAgents = Nothing 
    Set dicDates = Nothing 
    Set colDateData = Nothing 
End Sub 

代码中的错误出在这条线：

 dicDates.Item(dtDay) = colDateData 

的错误是Wrong number of arguments or invalid property assignment。我猜这是因为我试图分配一个集合。我如何使用更新的集合对象更新字典项目？

Answer 1

为了回答您的实际问题为，你有Object工作，但Dictionary.Item()是一个Variant财产。当您尝试分配引用类型（您的Collection）时，它会被强制转换为Variant，因此编译器不会捕获您在引用类型上使用非引用分配的事实。或者更简单地说，你错过了在转让前的Set：

Set dicDates.Item(dtDay) = colDateData 

这就是说，你其实可以删除该行完全，它会运作方式完全相同。您在dicDates中存储的Collection不是需要替换的副本 - 它是对同一对象的引用。如果你需要的核查试试这个简单的演示代码：

Sub Example() 
    Dim foo As New Scripting.Dictionary 
    Dim bar As Collection 

    Set bar = New Collection 'Make a bar and add some items. 
    bar.Add 1 
    bar.Add 2 
    foo.Add "key", bar   'Put it in the foo. 

    Set bar = Nothing   '<--this destroys the *local* reference. 

    foo.Item("key").Add 3  'Add a value directly via the return of .Item() 

    Dim x As Variant 
    For Each x In foo.Item("key") 
     Debug.Print x   'Prints 1, 2, 3 
    Next 
End Sub 

所以...你可以只包是整段的With块，而不是拉参考到colDateData在所有简化代码：

'Get this day's collection 
    With dicDates.Item(dtDay) 
     'Total the minutes 
     intMinutes = .Item("Minutes") + wsAllData.Cells(rAllData, 3).Value 
     .Remove "Minutes" 
     .Add intMinutes, "Minutes" 
     'Add unique names 
     Set dicAgents = .Item("Names") 
     If Not dicAgents.Exists(wsAllData.Cells(rAllData, 4).Value) Then 
      dicAgents.Add _ 
       wsAllData.Cells(rAllData, 4).Value, wsAllData.Cells(rAllData, 4).Value 
      .Remove "Names" 
      .Add dicAgents, "Names" 
     End If 
     'Add unique Cases 
     If Len(wsAllData.Cells(rAllData, 5).Value) = 15 And _ 
      IsNumeric(wsAllData.Cells(rAllData, 5).Value) Then 
      'Looks like a Case so add it if it doesn't already exist 
      Set dicCases = .Item("Cases") 
      If Not dicCases.Exists(wsAllData.Cells(rAllData, 5).Value) Then 
       dicCases.Add _ 
        wsAllData.Cells(rAllData, 5).Value, wsAllData.Cells(rAllData, 5).Value 
       .Remove "Cases" 
       .Add dicCases, "Cases" 
      End If 
     End If 
    End With