Блог

Я изучаю VBA, и у меня есть упражнение, которое я нахожу трудным для решения. Вот пример основной таблицы:

    A        B      C       D
 person   team   date     task
--------------------------------
  toms      A    10/08     t1
  toms      A    10/08     t2
  toms      A    10/08     t3
  harry     B    10/08     t4
  harry     B    10/08     t5
  harry     B    11/08     t6
  toms      A    11/08     t7
  toms      A    11/08     t8
  jhon      B    11/08     t9
  

Цель состоит в том, чтобы подсчитать количество задач на человека в день.
Результат должен выглядеть следующим образом:

   A        B      C        D
 person   team   date     total    
--------------------------------
  toms      A    10/08      3
  toms      A    11/08      2
  harry     B    10/08      2
  harry     B    11/08      1
  jhon      B    11/08      1
  

Я думал использовать dictionary но, похоже, вы можете использовать только один ключ в словаре. Существует ли конкретная функция VBA, которая может помочь мне решить эту проблему?

Как сказал @Scott Craner, вы могли бы настроить сводную таблицу следующим образом:

Я бы использовал решение сводной таблицы (или Power Query) для решения этой проблемы, но для подхода с использованием словарей (поскольку вы изучаете методы) Я предлагаю следующее.

• Создайте словарь с ключом, являющимся вашим основным разделением. В вашем случае, похоже, так и будет name|team .
• В этом словаре будет храниться другой словарь с ключом = theDate и элементом = theCount
• работайте в массивах VBA для ускорения обработки (полезно на больших наборах данных)
• укажите ссылки на различные рабочие листы и диапазоны.

 'Set reference to Microsoft Scripting Runtime
Option Explicit
Sub countTasks()
    Dim dPerson As Dictionary, dDate As Dictionary
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim I As Long, sKeyP As String, dKeyDt As Date
    Dim V As Variant, W As Variant
    
'set worksheets, ranges, and read source data into variant array for processing speed
Set wsSrc = ThisWorkbook.Worksheets("sheet10")
Set wsRes = ThisWorkbook.Worksheets("sheet10")
    Set rRes = wsRes.Cells(1, 10)
    
With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=4)
End With

'iterate through the data and store the results
Set dPerson = New Dictionary
    dPerson.CompareMode = TextCompare 'case insensitive
    
For I = 2 To UBound(vSrc, 1)
    sKeyP = vSrc(I, 1) amp; "|" amp; vSrc(I, 2) 'will give different count for same name, different teams
    dKeyDt = vSrc(I, 3)
    
    If Not dPerson.Exists(sKeyP) Then
        Set dDate = New Dictionary
        dDate.Add Key:=dKeyDt, Item:=1
        dPerson.Add Key:=sKeyP, Item:=dDate
    Else
        With dPerson(sKeyP)
            If Not .Exists(dKeyDt) Then
                .Add Key:=dKeyDt, Item:=1
            Else
                .Item(dKeyDt) = .Item(dKeyDt)   1
            End If
        End With
    End If
Next I
                
'Format and output the results
I = 0
For Each V In dPerson.Keys
    For Each W In dPerson(V)
        I = I   1
    Next W
Next V

ReDim vRes(0 To I, 1 To 4)

'headers
vRes(0, 1) = "Person"
vRes(0, 2) = "Team"
vRes(0, 3) = "Date"
vRes(0, 4) = "Count"

'data
I = 0
For Each V In dPerson.Keys
    For Each W In dPerson(V)
        I = I   1
        vRes(I, 1) = Split(V, "|")(0)
        vRes(I, 2) = Split(V, "|")(1)
        vRes(I, 3) = W
        vRes(I, 4) = dPerson(V)(W)
    Next W
Next V

'write the results to the worksheet and format
Set rRes = rRes.Resize(UBound(vRes, 1)   1, UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    .Columns(3).NumberFormat = "dd/mmm/yyyy"
    With .Rows(1)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    .EntireColumn.AutoFit
End With
    
End Sub