超过255个字符的数组公式

运行我的VBA代码时出现错误。

运行时错误“1004”:无法设置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 

如果我将“.FormulaArray”replace为“.Formula”,然后手动将它作为一个数组(Ctrl + Shift + Enter),它工作正常,所以公式本身工作正常。

不幸的是,我不能简单得多,因为我可以有多达10个帐户,每个帐户都需要在每个单元格中引用(目前我用于testing的三个帐户有525个字符,但会根据名称的每个帐户是)。

正如我所说,似乎Excel没有这个问题…这是VBA的问题。

非常感谢

我发现你的公式中有一些乘法运算。 您可以将公式拆分成多个命名范围,然后使用另一个范围将它们组合起来。 例如,可以说你的公式可以分成两部分:

 = 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)”。

我有几个非常复杂的插入公式。

我做了一个代码,可以在英文A1-notation中插入long formulaarray-functions(开始时不带“=”),

用这个build议来代替公式,我正在寻找最常用的命令“if()”来尽可能多地dynamicreplace这个函数。 也许我可以通过分享为你节省几个小时的工作。

代码并不是要共享的,所以它在处理错误方面很差,代码被写成垃圾。 如果你需要改进它,那就这样做。 代码完整地用德语评论,我懒得翻译它(因为我的英语不是那么好)。 我会忘记这个post,可能永远不会再检查,所以我不能回答任何问题。

 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 

你需要提供一个从未在代码中使用过的行(用单元格replaceif-command)。 这是必要的,因为插入的公式必须在每一步中对vba和excel有意义。 集成的FormulaArray和Replace-command将无法使用无意义的公式,这是我为何取而代之的主要原因。 在这种情况下,uniqueLine是1337,但是如果需要的话,你可以改变它。

长度公差设置为150,这意味着只有短于150个字符的公式才会被replace。 R1C1-表示法中的255个计数的限制,即使它是作为A1-表示法给出的,所以处理的代码比给定的公式更长,并且您需要一定的余量空间。 你不需要那么多的空间,但它为我工作。

祝你今天愉快,

B_Nut