Fuction имеет массив внутри, возвращает ошибку 1004

Question

У меня есть формула, которая отлично работает в жестком коде, но выдает ошибку 1004, когда я помещаю ее в код. Я думаю, это потому, что я использую массив внутри формулы. Я пробовал .FormulaArray, но он все равно возвращает ошибку.

ws_a.Range("D2:D" & LastRowCriar).Formula = "=IFERROR(IFERROR(IFERROR(INDEX(IBAN!D:D,MATCH(B2&I2,IBAN!F:F&IBAN!E:E,0)),INDEX(IBAN!D:D,MATCH(B2&I2-1,IBAN!F:F&IBAN!E:E,0))),INDEX(IBAN!D:D,MATCH(B2&I2-2,IBAN!F:F&IBAN!E:E,0))),INDEX(IBAN!D:D,MATCH(B2&I2-3,IBAN!F:F&IBAN!E:E,0)))"

Еще раз, формула работает в жестком коде, мне просто нужна помощь, как использовать ее в VBA. Вероятно, я должен объявить эти массивы, но я не уверен (если я должен или как это сделать).

Закодировано:

=IFERROR(IFERROR(IFERROR(INDEX(IBAN!D:D;MATCH(B2&I2;IBAN!F:F&IBAN!E:E;0));INDEX(IBAN!D:D;MATCH(B2&I2-1;IBAN!F:F&IBAN!E:E;0)));INDEX(IBAN!D:D;MATCH(B2&I2-2;IBAN!F:F&IBAN!E:E;0)));INDEX(IBAN!D:D;MATCH(B2&I2-3;IBAN!F:F&IBAN!E:E;0)))

Спасибо!

Answer 1

Заменить медленную формулу на VBA

При этой настройке код будет записывать результирующие значения в 4-й ("D") столбец (cSh1C3) в Sheet1 с именем "Sheet1". Название листа не упоминалось, поэтому измените его соответствующим образом, также измените другие константы в соответствии с вашими потребностями. Возможно, сначала измените cSh1C3 на пустой столбец, чтобы увидеть, соответствует ли код ожидаемому. Не будет никаких формул, только значения, так как ваша формула значительно замедляет рабочий лист. Если этот код выполняет ожидаемое, то формула - нет. В некоторых случаях результаты отличаются, но я думаю, что код правильный. Когда это произойдет, проверьте точность вручную.

Option Explicit

Sub ReplaceSlowFormulaWithVBA()

    ' Sheet1
    Const cSh1 As String = "Sheet1"   ' Sheet1 Name
    Const cSh1FR As Long = 2          ' Sheet1 First Row Number
    Const cSh1C1 As Variant = 2 ' "B" ' Sheet1 First Column Number/Letter
    Const cSh1C2 As Variant = 9 ' "I" ' Sheet1 Second Column Number/Letter
    Const cSh1C3 As Variant = 4 ' "D" ' Target Column Number/Letter
                                      ' (Sheet1 Third Column Number/Letter)
    Const cReduce As Long = 3         ' Reduce Number

    ' Sheet2
    Const cSh2 As String = "IBAN"     ' Sheet2 Name
    Const cSh2FR As Long = 2          ' Sheet2 First Row Number
    Const cSh2C1 As Variant = 6 ' "F" ' Sheet2 First Column Number/Letter
    Const cSh2C2 As Variant = 5 ' "E" ' Sheet2 Second Column Number/Letter
    Const cSh2C3 As Variant = 4 ' "D" ' Source Column Number/Letter
                                      ' Sheet2 Third Column Number/Letter

    Dim ws1 As Worksheet              ' First Worksheet
    Dim ws2 As Worksheet              ' Second Worksheet
    Dim rng As Range                  ' Various Ranges
    Dim vnt1 As Variant               ' Sheet1 Array
    Dim vnt1C1 As Variant             ' Sheet1 First Column Array
    Dim vnt1C2 As Variant             ' Sheet1 Second Column Array
    Dim vntT As Variant               ' Target Array (Sheet1 Third Column Array)
    Dim vnt2 As Variant               ' Sheet2 Array
    Dim vnt2C1 As Variant             ' Sheet2 First Column Array
    Dim vnt2C2 As Variant             ' Sheet2 Second Column Array
    Dim vntS As Variant               ' Source Array (Sheet2 Third Column Array)
    Dim LR As Long                    ' Last Row Compare Number
    Dim sh1LR As Long                 ' Sheet1 (Current) Last Row Number
    Dim sh2LR As Long                 ' Sheet2 (Current) Last Row Number
    Dim UB1 As Long                   ' Sheet1 Arrays Upper Bound
    Dim UB2 As Long                   ' Sheet2 Arrays Upper Bound
    Dim i As Long                     ' Various Counters
    Dim j As Long                     ' Second Array Elements Counter
    Dim k As Long                     ' Reduce Counter
    Dim lng1 As Long                  ' Current Sheet1 Array Value
    Dim lng2 As Long                  ' Current Sheet2 Array Value

    ' IN RANGES

    ' Define Worksheets.
    Set ws1 = ThisWorkbook.Worksheets(cSh1)
    Set ws2 = ThisWorkbook.Worksheets(cSh2)

    ' Calculate Sheet1 Last Row Number.
    Set rng = ws1.Columns(cSh1C1): GoSub LastRow: sh1LR = LR
    Set rng = ws1.Columns(cSh1C2): GoSub LastRow
    If LR > sh1LR Then sh1LR = LR

    ' Calculate Sheet2 Last Row Number.
    Set rng = ws2.Columns(cSh2C1): GoSub LastRow: sh2LR = LR
    Set rng = ws2.Columns(cSh2C2): GoSub LastRow
    If LR > sh2LR Then sh2LR = LR
    Set rng = ws2.Columns(cSh2C3): GoSub LastRow
    If LR > sh2LR Then sh2LR = LR

    ' Write Column Ranges to Arrays.
    vnt1C1 = ws1.Cells(cSh1FR, cSh1C1).Resize(sh1LR - cSh1FR + 1)
    vnt1C2 = ws1.Cells(cSh1FR, cSh1C2).Resize(sh1LR - cSh1FR + 1)
    vnt2C1 = ws2.Cells(cSh2FR, cSh2C1).Resize(sh2LR - cSh2FR + 1)
    vnt2C2 = ws2.Cells(cSh2FR, cSh2C2).Resize(sh2LR - cSh2FR + 1)
    vntS = ws2.Cells(cSh2FR, cSh2C3).Resize(sh2LR - cSh2FR + 1)

    ' Define Target Range.
    Set rng = ws1.Cells(cSh1FR, cSh1C3).Resize(sh1LR - cSh1FR + 1)

    ' Release worksheet object variables.
    Set ws2 = Nothing
    Set ws1 = Nothing

    ' IN ARRAYS

    ' Define and populate Sheet1 Array from the two Sheet1 Column Arrays.
    UB1 = UBound(vnt1C1)
    ReDim vnt1(1 To UB1)          ' 1D 1-based (1-row)
    For i = 1 To UB1: vnt1(i) = vnt1C1(i, 1) & vnt1C2(i, 1): Debug.Print vnt1(i): Next i
    ' Erase the two Sheet1 Column Arrays.
    Erase vnt1C1: Erase vnt1C2
    ' Define and populate Sheet2 Array from the two Sheet2 Column Arrays.
    UB2 = UBound(vnt2C1)
    ReDim vnt2(1 To UB2)          ' 1D 1-based (1-row)
    For i = 1 To UB2: vnt2(i) = vnt2C1(i, 1) & vnt2C2(i, 1): Next i
    ' Erase the two Sheet2 Column Arrays.
    Erase vnt2C1: Erase vnt2C2
    ' Resize Target Array to rows defined by the number of elements
    ' in Sheet1 Array.
    ReDim vntT(1 To UB1, 1 To 1)  ' 2D 1-based 1-column

    ' Loop through elements of Sheet1 Array.
    For i = 1 To UB1
        If IsNumeric(vnt1(i)) Then
            ' Loop through Reduce Values.
            For k = 0 To cReduce
                ' Calculate Current Sheet1 Array Value.
                lng1 = vnt1(i) - k
                ' Loop through elements of Sheet2 Array.
                For j = 1 To UB2
                    If IsNumeric(vnt2(j)) Then
                        ' Calculate Current Sheet2 Array Value.
                        lng2 = vnt2(j)
                        ' Compare current Sheet1 and Sheet2 Array Values.
                        If lng1 = lng2 Then
                            ' Write value of current element (row) in Source
                            ' Array to current element (row) in Target Array.
                            vntT(i, 1) = vntS(j, 1)
                            ' Ensure exiting "For k"-loop immediately after
                            ' exiting "For j"-loop.
                            k = cReduce
                            ' Exit "For j"-loop.
                            Exit For
                        End If
                    End If
                Next j
            Next k
        End If
    Next i

    ' IN RANGES

    ' Write Target Array to Target Range.
    rng = vntT

Exit Sub

LastRow:
    LR = 0
    Set rng = rng.Find("*", , xlFormulas, , , xlPrevious)
    If Not rng Is Nothing Then LR = rng.Row
Return

End Sub