Как перебрать мой вариантный массив для подсчета с последующим вычислением?

Question

Я создал список массива вариантов уникальных элементов в Sheet1 из мастер-листа (Sheet3). Теперь я не уверен, как скопировать каждый элемент в моем массиве и вставить его на листе 4 в столбце A и подсчитать этот элемент на листе «Январь» рядом с ним в столбце B. Если я смогу это сделать, тогда я смогу выполнить некоторые расчет. Ваша помощь будет высоко оценена

Я в основном пытаюсь построить статистику управления информацией, подсчитать количество предметов, которыми мы управляем, а затем вычислить процентную долю выполненных в срок.

вот что я сделал до сих пор, чтобы получить список вариантов массива.

Sub PopulatingArrayVariable_v3()

Dim myarray() As Variant
Dim DataRange As range
Dim Cell As range
Dim x As Long
Dim iReport As Integer

Dim lastRow As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

lastRow = Sheets("Sheet3").range("A" & Rows.Count).End(xlUp).Row

With Sheets("Sheet3")

    .range("D2:D" & lastRow).AdvancedFilter Action:=xlFilterCopy, 
copytorange:=Sheets("Sheet1").range("A1"), Unique:=True

End With

Set DataRange = Sheets("Sheet1").UsedRange


For Each Cell In DataRange.Cells
ReDim Preserve myarray(x)
myarray(x) = Cell.Value
x = x + 1
Next Cell
For x = LBound(myarray) To UBound(myarray)
Debug.Print myarray(x)
Next x

iReport = WorksheetFunction.countif(Sheets("January").range("C6:C100"), 
myarray(6))

Sheets("Sheet4").Activate
range("A2") = myarray(6)
range("B2") = iReport

//do calculation in % and rounded to 0 decimal point

Application.ScreenUpdating = False
Application.DisplayAlerts = False


End Sub

вот пример того, как я хочу, чтобы конечная таблица выглядела как

Items                   Count
EMT - Pre Production     4
EMT - Pre Production     5
EMT - Production         10
EMT - Post Production    1
EPT - Pre Production     20
EPT - Production         10
EPT - Post Production    5
AIFMD  - Pre Production  25
AIFMD  - Production      12
AIFMD  - Post Production 12