Excel VBA计算包含特定值的行

lharry 发表于 Dev

拉里

我正在学习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

我想到要使用a，dictionary但似乎您只能在字典中使用一个键。是否有特定的VBA功能可以帮助我解决此问题？

罗恩·罗森菲尔德

我将使用数据透视表（或Power Query）解决方案来解决此问题，但是对于使用字典的方法（因为您正在学习技巧），我建议以下内容。

创建一个字典，其中的关键是您的主要分隔。在您的情况下，似乎会name|team。
该词典将存储另一个词典，其键为= theDate和item = 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) & "|" & 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