计算是否为excel VBA，并在另一个范围内打印结果

Question

我有一个大约 12,000 行的列表，其中包含项目编号、客户经理、创建日期、状态……等等。 目前我每两周制作一次报告，作为数据透视表，然后我用它们制作图表。我知道这可以自动化，因为我消除了数据透视表并使用 countifs 复制了结果。 现在我希望能够用 VBA 做同样的事情，直到用户可以进入电子表格，点击一个按钮，最新的数据就会被描绘出来。首先，我想探索一下 vba 中的一些 countif。

假设表格是这样的

 A          |         B       |    C
proj.Number   Account Manager   Status
   123            Person 1       Won
   234            Person 2       Lost
   345            Person 3       Quoted

目前这是我的代码，它适用于 countif，但它没有循环......而且我知道它可以以某种方式完成

 Dim PersonOne as Range
    Set PersonOne = Range("E2")
 Dim PersonTwo as Range
    Set PersonTwo = Range("E3") 
 Dim PersonThree as Range
    Set PersonThree = Range("E4")

        Range("D2") = "Person 1"
        Range("D3") = "Person 2"
        Range("D4") = "Person 3"

PersonOne = (WorksheetFunction.CountIf(Range("B2", Range("B2").End(xlDown)), "Person 1"))   
PersonTwo = (WorksheetFunction.CountIf(Range("B2", Range("B2").End(xlDown)), "Person 2"))  
PersonThree = (WorksheetFunction.CountIf(Range("B2", Range("B2").End(xlDown)), "Person 3")) 

我如何自动化这个，以至于我什至不必写人的名字（我说 range(d2) = some person 的部分 我是否可以有一个代码来查找所有可能的唯一名称，将它们放在电子表格的某个范围内，然后计算该名称在给定范围内出现的次数？

谢谢

Answer 1

下面的代码和函数应该可以满足您的需求。虽然它当前打印到同一页面上的 D 列和 E 列，但如果您想要它在其他地方，您可以轻松更改它。

Sub CountIF()

    Dim wbk As Workbook
    Dim ws As Worksheet
    Dim myNames() As String
    Dim lRow As Long, x As Long
    Dim Cell As Range
    Dim Test As Boolean

    Set wbk = Workbooks("Book1.xlsm") 'Change this to your workbook name
    Set ws = wbk.Worksheets("Sheet1") 'Change this to your worksheet name

    ReDim myNames(0 To 0) As String

    With ws
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row
        'Loop through Column B and populate array
        For Each Cell In .Range(.Cells(2, "B"), .Cells(lRow, "B"))
            'Check if Name is already in array
            Test = IsInArray(Cell.Value, myNames) > -1
            If Test = False Then
                'Insert name into array
                myNames(UBound(myNames)) = Cell.Value
                ReDim Preserve myNames(0 To UBound(myNames) + 1) As String
            End If
        Next Cell

        ReDim Preserve myNames(0 To UBound(myNames) - 1) As String
        'Print title in D and value in E
        For x = LBound(myNames) To UBound(myNames)
            'Use x + 1 because our array starts at 0
            .Cells(x + 1, "D").Value = myNames(x)
            .Cells(x + 1, "E").Value = WorksheetFunction.CountIF(.Range(.Cells(2, "B"), .Cells(lRow, "B")), myNames(x))
        Next x
    End With

    Erase myNames

End Sub

代码使用了这个函数，所以一定要包含它

Function IsInArray(stringToBeFound As String, arr As Variant) As Long
'http://stackoverflow.com/questions/10951687/how-to-search-for-string-in-an-array
'Boolean = (IsInArray(StringToFind, ArrayToSearch) > -1)
    Dim i As Long
    ' default return value if value not found in array
    IsInArray = -1

    For i = LBound(arr) To UBound(arr)
        If StrComp(stringToBeFound, arr(i), vbTextCompare) = 0 Then
            IsInArray = i
            Exit For
        End If
    Next i
End Function

Answer 2

这就是您只能使用 数据透视表 应用它的方式：

首先：插入数据透视表/图表

插入包含所需所有列的数据透视表：

第二：过滤空白

然后您可以将所需字段添加到数据透视表。添加其中一列作为过滤器以忽略空白：

第三：追加数据

稍后您可以在表格底部附加数据：

第四：刷新

刷新工作簿：

一切准备就绪：

Answer 3

有点晚了，但是如果你录制 Data > Consolidate 的宏，你会得到类似：

Range("E1").Consolidate Sources:=Range("B:C").Address(, , xlR1C1, 1), Function:=xlCount, _
                        TopRow:=True, LeftColumn:=True, CreateLinks:=False