Посчитать количество совпадений в столбце

sqlStr = "SELECT i3.[Наименование средств защиты] from [База сотрудников$] is a3 Where i3.[Профессия или должность]='" & rs.Fields(0) & "'"

sqlStr = "SELECT i3.[Наименование средств защиты] FROM [Нормы СИЗ ()$] as i3 Where i3.[Профессия или должность]='" & rs.Fields(0) & "'"

Set sh_workers = ThisWorkbook.Worksheets("База сотрудников") ' закрепление объекта за переменной
    Set workersListObj = sh_workers.ListObjects("employees") ' обозначение таблицы
    Set workersListRow = workersListObj.ListRows.Add ' добавление строки
     Set sh_prof = ThisWorkbook.Worksheets("Нормы СИЗ ()")
    Set profListObj = sh_prof.ListObjects("СИЗы")

Dim workersListObj As ListObject
Dim profListObj As ListObject
Dim workersListRow As ListRow
Dim profListRow As ListRow

Option Explicit
 
Sub tt()
    Dim Dic As Object, a, i&, t$, c As Collection, el
    a = Sheets("Нормы СИЗ ()").[a1].CurrentRegion.Value
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        .comparemode = 1
        For i = 2 To UBound(a)
            t = a(i, 1)
            If Not .exists(t) Then .Add t, New Collection
            .Item(t).Add a(i, 2)
        Next
    End With
 
    With Sheets("База сотрудников")
        For i = 4 To 2 Step -1
            t = .Cells(i, 9)
            If Dic.exists(t) Then
                Set c = Dic.Item(t)
                For Each el In c
                    Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    .Cells(i + 1, 10) = el
                    '.Cells(i + 1, 11) = cell.Cells(1, 4)(i)
                    .Cells(i + 1, 12) = "18.04.2017"
                Next
            End If
        Next
    End With
End Sub

For i = UBound(a) To 2 Step -1