excel - 函数内部有一个数组，返回错误 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)))

谢谢！

标签： excelvba

Answer 1

用 VBA 替换慢公式

使用此设置，代码会将结果值写入名为“Sheet1”的第 4 (“D”) 列 ( cSh1C3) 。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