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

Question

Я пытаюсь написать процедуру, которая автоматически добавляет новые столбцы и заполняет их. У меня есть следующие коды в VBA для автоматизации процесса:

Sub AddHeader()
    Worksheets(1).Range("Y1").Formula = "Alder"
    Worksheets(1).Range("Z1").Formula = "Premier"
End Sub


Sub AddFormula()
    Dim Formulas(1 To 2) As Double
    With ThisWorkbook.Worksheets
        Formulas(1) = "=INT((TODAY()-J2)/365,25)"
        Formulas(2) = "=IF(L2="";0;L2)"
        .Range("Y2:Z2").Formula = Formulas
        .Range("Y:Z").NumberFormat = "General"
    End With
End Sub

Sub FillColumnY()
    Dim LastRow As Long
    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("Y2:Y" & LastRow).FillDown
End Sub

Sub FillColumnZ()

    Dim LastRow As Long
    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("Z2:Z" & LastRow).FillDown
End Sub

Моя проблема - это программа AddFormula(), которая выдает следующее сообщение об ошибке:

«Ошибка компиляции. - Не удалось найти данные или элемент "

Когда я пытаюсь скомпилировать AddFormula() вручную, я получаю следующую ошибку:

« Ошибка времени выполнения »9 ', Нижний индекс вне допустимого диапазона "

Надеюсь, кто-нибудь может мне помочь

Answer 1

Сначала вы получите ошибку в этой процедуре, используя With ThisWorkbook.Worksheets - вы не указали, какой лист - он пытается просмотреть все листы.
Попробуйте With ThisWorkbook.Worksheets(1)

Далее вы определили формулы как двойные, которые принимают только числа.
Затем вы пытаетесь присвоить ему текстовую строку "=INT((TODAY()-J2)/365,25)".

Попробуйте что-то вроде этого:

 Public Sub All_Together()

    Dim LastRow As Long

    With ThisWorkbook.Worksheets("Sheet1")
        .Range("Y1:Z1") = Array("Alder", "Premier")
        '.Range("Y2").Formula = "=INT((TODAY()-J2)/365.25)"
        '.Range("Z2").Formula = "=IF(L2="""",0,L2)" 'Note doubling up of quotes in string.

        .Range("Y2").Formula = "=INT((TODAY()-J2)/365,25)"
        .Range("Z2").Formula = "=IF(L2="""";0;L2)"

        'If there's no data on the sheet LastRow will throw an error.
        On Error Resume Next
            LastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If LastRow = 0 Then LastRow = 1
        On Error GoTo 0

        .Range("Y2:Z" & LastRow).FillDown
    End With

End Sub

Answer 2

Попробуйте заменить

Dim Formulas(1 To 2) As Double

в

Dim Formulas(1 To 2) As Variant

Но это не причина вашей ошибки. Это покажет «Несоответствие типов». Вы вводите строки в массив. Независимо от того, каким будет результат формулы ...

Тогда,

With ThisWorkbook.Worksheets не имеет никакого значения для VBA, в этом контексте, и эта строка проблематична c, повышая ошибка в обсуждении.

Это должно быть With ThisWorkbook.Worksheets(1), или With ThisWorkbook.Worksheets("My Sheet"), или даже With ActiveSheet ...

И, если вы попытаетесь использовать его для копирования массива в все листы это надо делать по-другому. Я покажу вам, как, если это было вашим намерением ...

Дополнительно, формула таким образом "=IF(L2="";0;L2)" может работать не так, как вам нужно. Даже если, согласно локализации, разделителем формул является «;», рекомендуется использовать "=IF(L2="",0,L2)". Excel выполнит соответствующее преобразование , и в случае использования книги на компьютере с разделителем-запятой ошибка не возникнет. Из-за этого вы также можете получить ошибку в строке .Range("Y2:Z2").Formula = Formulas. Вы можете решить эту проблему, выполнив то, что я рекомендовал выше ...

Фактически ваша функция должна выглядеть так:

Sub AddFormula()
    Dim Formulas(1 To 2) As Variant
    With ActiveSheet 'ThisWorkbook.Worksheets
        Formulas(1) = "=INT((TODAY()-J2)/365.25)"
        Formulas(2) = "=IF(L2="""",0,L2)"
        .Range("Y2:Z2").Formula = Formulas
        .Range("Y:Z").NumberFormat = "General"
    End With
End Sub

Вы получаете сообщение об ошибке, потому что обе строки ваших формул содержат ошибки: 365,25 должно быть 365.25. В противном случае VBA считает, что это еще одно разделение списка (,), и произойдет ошибка, и каждый символ двойных кавычек должен быть удвоен в строке. Я имею в виду, что "=IF(L2="",0,L2)" должно стать "=IF(L2="""",0,L2)".

Теперь, когда я уверен, что указанная выше функция будет работать, я отправлю еще одну, способную заполнить (сразу) все столбцы, которые вам нужно заполнить вниз отдельным шагом:

Sub AddFormulaBis()
    Dim Formulas(1 To 2) As Variant, lastRow As Long
    With ActiveSheet 'ThisWorkbook.Worksheets
        lastRow = .Range("J" & Rows.Count).End(xlUp).row
        Formulas(1) = "=INT((TODAY()-J2)/365.25)"
        Formulas(2) = "=IF(L2="""",0,L2)"
        .Range("Y2:Z" & lastRow).Formula = Formulas
        .Range("Y2:Z" & lastRow).NumberFormat = "General"
    End With
End Sub