最简单的方法是首先显示一些样本数据，然后是我的预期输出。
我有一张看起来像这样的表：
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。我猜这是因为我试图分配一个集合。如何使用更新的集合对象更新字典项？
答案 0 :(得分：3)
要回答您的实际问题，您正在使用Object，但Dictionary.Item()是Variant属性。当您尝试分配引用类型（您的Collection）时，它会被强制转换为Variant，因此编译器无法捕获您在引用上使用非引用赋值的事实类型。或者更简单地说，您在作业前面错过了Set：
Set dicDates.Item(dtDay) = colDateData
也就是说，你可以完全删除该行，它的功能完全相同。您在Collection中存储的dicDates不是需要替换的副本 - 它是对同一对象的引用。如果您需要验证，请尝试使用这个简单的演示代码：
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