255 자 이상의 배열 수식

Question

VBA 코드를 실행할 때 오류가 발생합니다.

런타임 오류 '1004': 나는 255 자 이상을 가지고 있기 때문에이 가정 레인지 클래스

의을 FormulaArray 속성을 설정하려면 수 없습니다.

이 경우 내가 사용할 수있는 임시 해결책을 알고있는 사람이 있습니까?

내 코드는 아래의 아름다운 엉망이다 : 나는 ".Formula 문"과 ".FormulaArray"를 교체 한 후 수동으로 그것을 배열을하면

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 

(Ctrl 키를 입력 + Shift 키를 +)는 그래서 잘 작동 수식 자체가 잘 작동합니다.

불행히도 각 셀 내에서 참조해야하는 10 개의 계정을 가질 수 있기 때문에 훨씬 간단하게 만들 수는 없습니다. (테스트를 위해 현재 사용하고있는 3 가지 계정은 525 자이지만, 각 계정의 이름이 무엇이든간에).

내가 말했듯이 Excel에는 문제가없는 것 같습니다 ... 문제가있는 VBA입니다.

많은 감사

Answer 1

나는 당신이 수식의 일부 곱셈을 가지고 참조하십시오. 수식을 여러 개의 명명 된 범위로 나눈 다음 다른 범위를 사용하여 다시 결합 할 수 있습니다.

= formulaPart1 * formulaPart2 

당신은 다음을 통해 두 개의 명명 된 범위를 정의 할 수 있습니다 :

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

그리고 당신이 당신의 최종 결과를 설정할 수 있습니다 예를 들어, 수식이 같은 두 부분으로 나눌 수 있습니다 말할 수 있습니다 :

= firstPart * secondPart 

편집 : 합칠 각 요소에 대해 명명 된 범위를 정의 할 수도 있습니다.

"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)"과 같이 될 것이다 : 예를 들어이 설정 한 명명 된 범위가 될 것입니다 그래서, 당신이 sumElement1 이름을 말할 수 있습니다.

Answer 2

삽입 할 몇 가지 매우 길고 복잡한 수식이 있습니다.

나는, 내가 "가장 일반적인 명령을 찾고 공식을 대체 할 제안을 사용

("= "처음에없이) 영어 A1-표기법으로 긴을 FormulaArray-기능을 삽입 할 수있는 코드를 만들어 if() "를 사용하여 가능하면 많은 단계에서 함수를 동적으로 대체하십시오. 어쩌면 내가 공유하여 몇 시간을 절약 할 수 있습니다.

코드는 공유하지 않으므로 오류 처리에 좋지 않으며 코드는 쓰레기로 처리됩니다. 그것을 개선해야 할 경우 그렇게하십시오. 코드가 독일어로 완성되어 주석 처리되었으며 번역하기가 너무 게으르다. (영어가 좋지 않기 때문에). 나는이 지위를 잊을 것이고 결코 그것을 다시 확인할 수 없을 것이다. 그래서 나는 어떤 질문에도 대답 할 수 없다.

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 명령을 셀로 바꾸려면 코드에 사용하지 않은 행을 입력해야합니다. 이것은 삽입 된 수식이 vba에 대해 의미가 있어야하고 모든 단계에서 탁월하기 때문에 필요합니다. 통합 된 FormulaArray 및 Replace-command는 내가이 efford를 대체 할 수 있었던 주된 이유 인 무의미한 공식으로는 작동하지 않습니다. 이 경우 uniqueLine은 1337이지만 필요한 경우 변경할 수 있습니다.

길이 허용 오차가 150으로 설정되어 있으므로 150 자보다 짧은 formulaparts 만 대체됩니다. R1- 표기법으로 주어진 경우에도 R1C1 표기법의 공식은 255로 제한되므로 처리 된 코드가 주어진 공식보다 길며 비트 헤드 룸이 필요합니다. 당신은 그다지 헤드 룸이 필요하지 않지만 그것은 나를 위해 일했습니다.

이 좋은 하루 되세요,

B_Nut