Подсчитайте, если для excel VBA, а результаты печати в другом диапазоне

Приведенный ниже код и функция должны делать то, что вам нужно. Хотя в настоящее время он печатается в столбцы 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

Вот как вы можете применить его только с помощью сводной таблицы:

Сначала: вставьте сводную таблицу / диаграмму

Вставьте сводную таблицу со всеми нужными столбцами:

Во-вторых: пустые фильтры

Затем вы можете добавить желаемое поле в сводную таблицу. Добавьте один из столбцов в качестве фильтра, чтобы игнорировать пробелы:

Третье: добавить данные

Позже вы можете добавить данные внизу своей таблицы:

Четвертое: обновить

Обновите книгу:

И все готово:

Немного поздно, но если вы запишете макрос Data> Consolidate, вы получите что-то вроде:

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