AW: VBA: SVerweis mit Left() as Matrixformel
03.09.2014 00:59:21
fcs
Hallo Robert,
die Funktionen in den Zellen einer Tabelle sind normalerweise schneller als die gleiche Funktion unter VBA. D.h. Es macht ggf. Sinn die Formeln per VBA in den Ergebniszellen einzufügen. Nach dem Einfügen der Formeln ersetzt man die Formeln durch Werte, um ggf. lange Neuberechnungszeiten zu vermeiden.
Die korrekte Formelsyntax bekommt man meist gut hin, indem man die Formel für die 1. Zelle des Ergebnisbereiches mit dem Makro-Rekorder aufzeichnet. Dabei wird die Formel im allgemeinen im US-Format und in der R1C1-Schreibweise aufgezeichnet. Bei der Formeleingabe muss du darauf achten, dass die absoluten und relativen Bezüge in den Formelteilen für das anschliessenden Kopieren/Vervielfachen der Formel korrekt gesetzt werden.
Es kann manchmal Sinn machen, bei sehr vielen Zeilen, alle Berechnungen innerhalb von VBA in Datenarrays durchzuführen.
Nachfolgend Beispiele für beide Varianten.
Gruß
Franz
Sub prcFormelSverweis()
' prcFormelSverweis Makro
Dim wks As Worksheet, rngErgebnis As Range, Zeile As Long, StatusCalc As Long
'per Makrorecorder aufgezeichnete Formel für 1. Ergebnis-Zelle B2, Suchwert in A2
' Range("B2").Select
' ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1] &""*"",Daten!R2C1:R22C2,2,FALSE)"
Set wks = Worksheets("Ergebnisse") ' = ActiveSheet
'Makro-Bremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
With wks
'letzte Zeile mit Suchwerten in Spalte A
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngErgebnis = .Range(.Cells(2, 2), .Cells(Zeile, 2))
With rngErgebnis
.FormulaR1C1 = "=VLOOKUP(RC[-1] &""*"",Daten!R2C1:R22C2,2,FALSE)"
.Calculate
'Formeln durch Werte ersetzen
.Value = .Value
End With
End With
'Makro-Bremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub
Sub prcVBASverweis()
' Ergebnisse inerhalb von Daten-Array auswerten
Dim wksErgebnis As Worksheet, wksData As Worksheet
Dim rngSuchwerte As Range, rngErgebnisse As Range, rngMatrix As Range
Dim arrSuchwerte, arrErgebnisse, arrMatrix
Dim Zeile_S As Long, Zeile_M As Long, Zeile As Long, StatusCalc As Long
Set wksErgebnis = Worksheets("Ergebnisse")
Set wksData = Worksheets("Daten")
'Makro-Bremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
'Matrix-Wertebereich setzen und Werte in Array einlesen
With wksData
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngMatrix = .Range(.Cells(2, 1), .Cells(Zeile, 2))
arrMatrix = rngMatrix
'Suchspalte in Matrix auf Länge 12 einkürzen
For Zeile_M = LBound(arrMatrix, 1) To UBound(arrMatrix, 1)
arrMatrix(Zeile_M, 1) = Left(arrMatrix(Zeile_M, 1), 12)
Next Zeile_M
End With
'Such- und Ergebniswertebereich setzen und in Arrays einlesen
With wksErgebnis
'letzte Zeile in Spalte mit Suchwerten - Spalte A (1)
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngSuchwerte = .Range(.Cells(2, 1), .Cells(Zeile, 1))
Set rngErgebnisse = .Range(.Cells(2, 2), .Cells(Zeile, 2))
rngErgebnisse.ClearContents
arrSuchwerte = rngSuchwerte
arrErgebnisse = rngErgebnisse
End With
'Suchwerte abarbeiten
For Zeile_S = LBound(arrSuchwerte) To UBound(arrSuchwerte)
For Zeile_M = LBound(arrMatrix, 1) To UBound(arrMatrix, 1)
If arrSuchwerte(Zeile_S, 1) = arrMatrix(Zeile_M, 1) Then
arrErgebnisse(Zeile_S, 1) = arrMatrix(Zeile_M, 2)
Exit For
End If
Next Zeile_M
Next Zeile_S
'Ergebnis-Array in Tabelle eintragen
rngErgebnisse = arrErgebnisse
'Makro-Bremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
Erase arrSuchwerte, arrErgebnisse, arrMatrix
End Sub