その辞書に登録されているコレクションを使って辞書エントリを更新する

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