Excel VBA 计数包含特定值的行

Question

I'm learning VBA and I have an exercise that I find difficult to solve. Here's an example of the main table:

   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

The goal is to count the number of tasks per person per day. The result should look like this:

  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

I thought of using a dictionary but it seems like you can only use one key in a dictionary. Is there a specific VBA function that can help me solve this problem?

Answer 1

Like @Scott Craner said, you could set up a PivotTable like this:

Answer 2

I would use a Pivot Table (or Power Query) solution for this problem, but for an approach using dictionaries (since you are learning techniques) I suggest the following.

• Create a dictionary with the key being your major separation. In your case, it appears it would name|team .
• This dictionary will store another dictionary with key=theDate and item=theCount
• work in VBA arrays for speedier processing (useful on large data sets)
• qualify your various worksheet and range references.

'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) & "|" & 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