Question

我在运行VBA代码时遇到错误。

运行时错误＆＃39; 1004＆＃39;：无法设置Range类的FormulaArray属性

我认为这是因为我有超过255个字符。

如果是这种情况，是否有人知道我可以使用的解决方法？

我的代码是下面美丽的混乱：

formula_string = "=-SUM("
account_counter = 1
Do Until Range("tblAccounts[[#Headers],[Accounts]]").Offset(account_counter, 0).Value = ""
    account_name = Range("tblAccounts[[#Headers],[Accounts]]").Offset(account_counter, 0).Value
    formula_string = formula_string & "IF(IFERROR(" & account_name & "[Category]=[@Categories],FALSE)*(" & account_name _
        & "[Transaction date]>=Budget!C$1)*(" & account_name & "[Transaction date]<=EOMONTH(Budget!C$1,0))," & account_name _
        & "[Outflow],0),"
    account_counter = account_counter + 1
Loop
formula_string = Left(formula_string, Len(formula_string) - 1) & ")"

    Do Until Range("tblBudget[[#Headers],[Ignore?]]").Offset(category_counter, 0).Value = ""
        If Range("tblBudget[[#Headers],[Ignore?]]").Offset(category_counter, 0).Value = "No" Then
            Do Until Range("tblBudget[[#Headers],[Ignore?]]").Offset(0, column_counter).Value = ""
                If Right(Range("tblBudget[[#Headers],[Ignore?]]").Offset(0, column_counter).Value, 8) = "Outflows" Then
                    Range("tblBudget[[#Headers],[Ignore?]]").Offset(category_counter, column_counter).Select
                    Selection.Formula = formula_string
                End If
                column_counter = column_counter + 1
            Loop
        End If
        category_counter = category_counter + 1
    Loop

如果我更换＆＃34; .FormulaArray＆＃34;与＆＃34; .Formula＆＃34;然后手动使它成为一个数组（Ctrl + Shift + Enter）它工作正常，所以公式本身工作正常。

不幸的是，我不能让它变得更简单，因为我可以拥有多达10个帐户，每个帐户都需要在每个单元格中引用（目前我用于测试的三个帐户有525个字符，但它＆＃ 39; ll会根据每个帐户的名称而改变。）

正如我所说，似乎Excel对此没有任何问题......它的VBA存在问题。

非常感谢

Answer 1

我看到你的公式中有一些乘法。您可以将公式拆分为多个命名范围，然后使用另一个范围将它们组合回来。例如，假设您的公式可以分为两部分，如下所示：

= formulaPart1 * formulaPart2

然后，您可以通过以下方式定义两个命名范围：

ActiveWorkbook.Names.Add Name:="firstPart" RefersToR1C1:="formulaPart1"
ActiveWorkbook.Names.Add Name:="secondPart" RefersToR1C1:="formulaPart2"

然后您可以将最终结果设置为：

= firstPart * secondPart

编辑：你甚至可以为你想要求和的每个元素定义一个命名范围。因此，例如，这将是一个要设置的命名范围，假设您将其命名为sumElement1：

"IF(IFERROR(" & account_name & "[Category]=[@Categories],FALSE)*(" & account_name _
        & "[Transaction date]>=Budget!C$1)*(" & account_name & "[Transaction date]<=EOMONTH(Budget!C$1,0))," & account_name _
        & "[Outflow],0)"

然后公式将类似于“= -SUM（sumElement1，sumElement2，...，sumElementn）”。

Answer 2

我有几个很长很复杂的公式要插入。

我制作了一个代码，可以在英文A1-notation中插入长的formulaarray函数（没有＆＃34; =＆＃34;在开头）

使用建议替换公式，我正在寻找最常见的命令＆＃34; if（）＆＃34;在尽可能多的步骤中动态替换函数。也许我可以通过分享来节省你几个小时的工作。

代码并不打算共享，因此它在处理错误方面表现不佳而且代码写得无用。如果您需要改进它，请执行此操作。代码用德语完整评论，我懒得翻译它（因为我的英语不是那么好）。我会忘记这篇文章，可能永远不会再检查，所以我无法回答任何问题。

Public Sub InsertFormulaArray(formula As String, targetCell As Range)
'Die Zeile der Zellenangabe für die Platzhalter
'Existiert in der Formel eine Zeilenangabe, die diesen Wert enthält, muss dieser Wert geändert werden.
Dim uniqueLine As String
uniqueLine = 1337
'Substituiert If-Funktionen, die kürzer sind als dieser Wert
'dieser Wert muss kleiner sein als die R1C1-Notation jeder If-Funktion innerhalb der Gesamtfunktion.
Dim lenghtTolerance As Integer
lenghtTolerance = 150

'Initialisiert Array, um die Ersetzungen zu protokollieren
Dim arrLenght As Integer
arrLenght = -1
Dim replaceArr() As String

'speichert der InputString für die Prüfung am Ende
Dim InputFormula As String
InputFormula = "=" & formula


'Suche die IF Befehle
Dim currentIF As Integer
Dim replaceChar As Integer
replaceChar = Asc("A")
Dim compression As Integer

'Sprungmarke, für eine mehrdimensionale kompression
RestartReplacement:
'inputLen benötige ich für die Entscheidung, ob eine weitere kompression notwendig ist
'(vergleich vorher nachher)
Dim inputLen As Integer
inputLen = Len(formula)

'findet den Anfang der ersten If-Funktion der Formel
currentIF = InStr(1, formula, "IF(")
'Findet das Ende der aktuellen If-Funktion
While Not currentIF = 0
    'gibt die Tiefe der aktuellen If-Funktion an
    Dim depth As Integer
    depth = 0
    'gibt die position der letzten Ziffer der aktuellen If-Funktion an. (0 - nicht gefunden)
    Dim ifEnd As Integer
    ifEnd = 0

    'Setzt und initialisiert den Zähler
    '(Position im String bei der Suche nach dem Ende der Funktion)
    Dim i As Integer
    i = currentIF

    'Zu Debug-Zwecken habe ich mir die aktuelle Ziffer herausgezogen
    Dim currentChar As String
    'Schleife, bis das Ende der If-Funktion gefunden wurde - Fehler falls nicht
    While ifEnd = 0
        currentChar = Mid(formula, i, 1)
        'Ermittelt die aktuelle tiefe
        If currentChar = "(" Then
            depth = depth + 1
        End If
        If currentChar = ")" Then
            depth = depth - 1
            'Setze ifEnd, wenn genausoviele Klammern geschlossen wie geöffnet wurden
            If depth = 0 Then
                ifEnd = i
            End If
        End If
        'Zähler rauf
        i = i + 1
        'Gibt einen Fehler zurück, wenn "i" größer ist, als der String
        If i > Len(formula) And ifEnd = 0 Then
            MsgBox "Die eingegebene Formel ist keine gültige Englische Formel: " & """" & formula & """"
            End
        End If
    Wend

    'Gebe die ermittelte If-Funktion als String aus
    Dim ifFunction As String
    ifFunction = Mid(formula, currentIF, (ifEnd + 1 - (currentIF)))

    'Ersetze die IF-Formel, wenn sie kürzer ist, als lenghtTolerance
    If Len(ifFunction) < lenghtTolerance Then
        'Schreibt den String in ein Array
        arrLenght = arrLenght + 1
        ReDim Preserve replaceArr(arrLenght)
        replaceArr(arrLenght) = ifFunction

        'Substituiere die If-Funktion in die Formel
        formula = Replace(formula, ifFunction, Chr(replaceChar) & uniqueLine)
        replaceChar = replaceChar + 1

        'Wirft mich raus, wenn die Formel 26 mal substituiert wurde
        If replaceChar > Asc("Z") Then
            'Sorge dafür, dass ich beim nächsten Versuch aus dem While fliege
            currentIF = Len(formula) - 1
            'Sorge dafür, dass ich mich nicht mehr wiederhole -> compression = 0
            inputLen = Len(formula)
        End If
    End If

    'Sucht den Anfang der nächsten If-Funktion
    currentIF = InStr(currentIF + 1, formula, "IF(")
Wend
'Ermittel, wie stark die Funktion durch diesen Vorgang komprimiert wurde
compression = inputLen - Len(formula)

'Überprüft, ob noch IF-Funktionen vorhanden sind
'Wiederholt die kompression, falls die letzte kompression nicht erfolglos war
If currentIF = 0 And InStr(1, formula, "IF(") > 0 And compression > 0 Then
    GoTo RestartReplacement
End If

'Schreibt die komprimierte Formel in die gewünschte Zelle
Application.ScreenUpdating = False
targetCell.FormulaArray = ("=" & formula)

'Setzt replaceChar eins zurück, um den letzten ersetzenden Buchstaben anzugeben
replaceChar = replaceChar - 1

'Ersetzt rückwärts alle "replacements"
For i = arrLenght To 0 Step -1
    'Dim replacementStr As String
    'replacementStr = Chr(replaceChar) & uniqueLine
    targetCell.Replace What:=(Chr(replaceChar) & uniqueLine), replacement:=replaceArr(i), LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    replaceChar = replaceChar - 1
Next i
Application.ScreenUpdating = True

'Überprüfe das Ergebnis
Dim result As String
result = targetCell.FormulaArray
If result = InputFormula Then
    'Einsetzen erfolgreich!
Else
    MsgBox "Beim einsetzen einer Formel in die Zelle """ & targetCell.Address & """ ist ein Fehler aufgetreten!" & vbCrLf & "Die aktuelle Aktion wird abgebrochen!"
    End
End If
End Sub

您需要提供一个从未在代码中使用的行（用单元格替换if-command）。这是必要的，因为插入的公式必须对vba有意义并且在每个步骤中都表现出色。集成的FormulaArray和Replace-command不适用于无意义的公式，这是我使这个efford替代的主要原因。在这种情况下，uniqueLine是1337，但您可以根据需要进行更改。

长度公差设置为150，这意味着只有短于150个字符的公式部分将被替换。 R1C1表示式中公式的限制为255，即使它以A1表示法给出，因此处理后的代码比给定的公式长，并且您需要一点余量。你不需要那么大的空间，但它对我有用。

度过愉快的一天，

B_Nut

包含超过255个字符的数组公式

2 个答案: