Aktualisieren eines Wörterbucheintrags mit einer in diesem Wörterbuch gespeicherten Sammlung

Question

Es ist wahrscheinlich am einfachsten, dies zu erklären, indem zuerst einige Beispieldaten gefolgt von meiner erwarteten Ausgabe angezeigt werden.

Ich habe ein Blatt, das wie folgt aussieht:

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 

ich brauche die Ausgabe wie folgt aussehen:

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

Agent-Count die Gesamtzahl der einzelnen Agenten ist und Fallzahl ist die Gesamtzahl der Einzelfälle für diesen Tag. Minuten sind nur eine Summe aller Minuten für den Tag. Datensätze können nicht nach Datum ohne größere Änderungen an mehreren vorhandenen Prozeduren sortiert werden.

Mein Ansatz dazu war, ein Wörterbuch nach Datum zu erstellen, wobei das Element eine Sammlung der 3 gewünschten Ausgaben ist. Die Sammlung würde dann ein Wörterbuch von Namen, ein Wörterbuch von Fällen und insgesamt die Minuten enthalten. Dies ist der Code, den ich das erreichen bin mit:

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 

Die Codefehler heraus auf dieser Linie:

 dicDates.Item(dtDay) = colDateData 

Der Fehler ist Wrong number of arguments or invalid property assignment. Ich vermute, das liegt daran, dass ich versuche, eine Sammlung zuzuweisen. Wie kann ich das Wörterbuchelement mit dem aktualisierten Sammlungsobjekt aktualisieren?

Answer 1

Um Ihre tatsächliche Frage ist zu beantworten, dass Sie mit einem Object arbeiten, aber Dictionary.Item() ist eine Variant Eigenschaft. Wenn Sie versuchen, einen Referenztyp zuzuweisen (Ihr Collection), wird es in Variant gezwungen, so dass der Compiler die Tatsache nicht erfasst, dass Sie eine Nicht-Referenzzuweisung für einen Referenztyp verwenden. Oder kürzer gesagt, du bist die Set vor der Zuordnung fehlt:

Set dicDates.Item(dtDay) = colDateData 

Das heißt, können Sie löschen tatsächlich diese Zeile vollständig und es würde funktionieren genau die gleiche Weise. Die Collection, die Sie in dicDates speichern, ist keine Kopie, die ersetzt werden muss - es ist eine Referenz auf das gleiche Objekt. Versuchen Sie diesen einfachen Demo-Code, wenn Sie die Überprüfung der des brauchen:

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 

So ... Sie können Ihren Code vereinfachen, indem sie genau den gesamten Abschnitts in einem With Block Einwickeln und nicht die Referenz in colDateDatabei allen ziehen:

'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