Formeln - auch Array - per VBA eintragen...

Frage: In einer Tabelle habe ich einige Formeln, die ich - aus welchem Grund auch immer - per VBA eintragen möchte. Wie geht das?

Hier noch eine Beispieldatei: Formeln - auch Array - per VBA eintragen...

WICHTIG! In der Formel vorkommende Hochkommata müssen gedoppelt werden - also aus "" wird """"!

Zunächst wird die Zelle mit der Formel markiert.


Dann öffnet man im VBA-Editor das Direktfenster bzw. den Direktbereich (wenn nicht schon geschehen) per STRG+G, gibt folgendes ein (inklusive das Fragezeichen am Anfang) und beendet die Zeile mit Return:


Das gleiche für die Formel in B1:


Dann die Formeln in VBA so nutzen - Arrayformeln werden mit Evaluate direkt in VBA berechnet:


Über "Application.ErrorCheckingOptions.BackgroundChecking" wird verhindert, dass dieses "grüne" Flag mit dem Fehlerhinweis (Zahl als Text) angezeigt wird. Weitere Beispiele folgend und in der Beispieldatei.

Option Explicit
'-------------------------------------------------------------------------- 
' Module    : Modul1 
' Procedure : Main 
' Author    : Case (Ralf Stolzenburg) 
' Date      : 10.12.2012 
' Purpose   : Formeln per VBA eintragen... 
'-------------------------------------------------------------------------- 
Sub Main()
    With Tabelle1
        .Range("E1").NumberFormat = "@"
        .Range("E1").Formula = _
            .Evaluate("=RIGHT(A1,COUNT(RIGHT(A1,COLUMN(1:1))*1))")
        Application.ErrorCheckingOptions.BackgroundChecking = False
        .Range("D1").Formula = "=MID(A1,1,LEN(A1)-LEN(C1))"
    End With
End Sub
Sub Main_1()
    Dim lngLastRow As Long
    With Tabelle1
        lngLastRow = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
            .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("G1:G" & lngLastRow).NumberFormat = "@"
        For lngLastRow = 1 To lngLastRow
            .Range("G" & lngLastRow).Formula = _
                .Evaluate("=RIGHT(A" & lngLastRow & ",COUNT(RIGHT(A" & _
                lngLastRow & ",COLUMN(1:1))*1))")
        Next lngLastRow
        Application.ErrorCheckingOptions.BackgroundChecking = False
        .Range("F1:F" & lngLastRow).Formula = "=MID(A1,1,LEN(A1)-LEN(C1))"
    End With
End Sub
Sub Main_2()
    Dim lngLastRow As Long
    With Tabelle1
        lngLastRow = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
            .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("I1:I" & lngLastRow).NumberFormat = "@"
        For lngLastRow = 1 To lngLastRow
            .Range("I" & lngLastRow).Formula = _
                .Evaluate("=RIGHT(A" & lngLastRow & ",COUNT(RIGHT(A" & _
                lngLastRow & ",COLUMN(1:1))*1))")
        Next lngLastRow
        Application.ErrorCheckingOptions.BackgroundChecking = False
        .Range("H1:H" & lngLastRow).Formula = "=MID(A1,1,LEN(A1)-LEN(C1))"
        .Range("H1:H" & lngLastRow).Value = .Range("H1:H" & lngLastRow).Value
    End With
End Sub

Beliebte Posts aus diesem Blog

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...