Заполнение диапазона тревог 3 формулами, содержащими многократную ссылку на список в Excel VBA

Question

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

Первый столбец должен содержать диапазон дат.

Я заполняю его таким образом:

Sub FillDate()

    Dim startDate As Date
    Dim endDate As Date
    Dim row As Long

    startDate = "01.08.2019"
    endDate = "07.08.2019"
    row = 2
    Do Until startDate = endDate + 1
        Range("A" & row).Value = startDate
        startDate = startDate + 1
        row = row + 1
    Loop  
End Sub

Это дает мне столбец A с датами с 01.08.2019 по 07.08.2019, начиная со второго ряда.

В столбцах B и C я хотел бы указать буксировкуформулы.

Формула для столбца B должна выглядеть следующим образом:

=COUNTIF('Sheet (i)'!G$2:G$5000, $A2)

, где i - итератор, поэтому формула в B2 должна выглядеть как

=COUNTIF('Sheet (1)'!G$2:G$5000, $A2)

и формула в B3 должна выглядеть как

=COUNTIF('Sheet (2)'!G$2:G$5000, $A3)

и т. д.

Эта формула ищет значение в ячейке A2 и вычисляет, сколько раз это значение найдено в диапазоне G $ 2.: G $ 5000 на листе с именем Sheet (1).

Формула для столбца C должна выглядеть следующим образом:

=ROUND(MEDIAN($B$2:$B$n), 0)

, где n - количество строк в столбце A на текущем листе.

Как

=ROUND(MEDIAN($B$2:$B$8), 0)

Я пришел со следующим решением:

Sub Fill()

Dim strFormulas(1 To 2) As Variant
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim i As Integer

'Application.ScreenUpdating = True

With ThisWorkbook.Sheets("Test")

     strFormulas(1) = "=COUNTIF('Sheet (1)'!G$2:G$5000, $A2)"
     strFormulas(2) = "=ROUND(MEDIAN($B$2:$B$8), 0)"

     .Range("C2:D2").Formula = strFormulas
     .Range("C2:D8").FillDown
End With
End Sub

Однако это только заполняет столбец C правильной формулой.

Вопрос: какзаполнить столбец B так, чтобы ячейка B2 содержала =COUNTIF('Sheet (1)'!G$2:G$5000, $A2), ячейка B3 содержала =COUNTIF('Sheet (2)'!G$2:G$5000, $A2) и т. д. до =COUNTIF('Sheet (8)'!G$2:G$5000, $A2)?

Заранее спасибо.

Answer 1

Sub Fill()

Dim strFormula_template As String
Dim strFormulas(1 To 2) As Variant
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim iCt As Integer

'Application.ScreenUpdating = True

With ThisWorkbook.Sheets("Test")

    strFormula_template = "=COUNTIF('Sheet (count)'!G$2:G$5000, $Axx)"
    strFormulas(2) = "=ROUND(MEDIAN($C$2:$C$8), 0)"

    For iCt = 1 To 7
        strFormulas(1) = Replace(strFormula_template, "count", iCt)
        strFormulas(1) = Replace(strFormulas(1), "xx", iCt + 1)
        .Range("C1:D1").Offset(iCt, 0).Formula = strFormulas
    Next

End With
End Sub