Excel stürzt ab | VBA
29.06.2020 15:57:59
Michael
ich habe eine Frage zu meinem Makro.
Link zur Excel Datei: https://www.herber.de/bbs/user/138633.xlsm
In der Exceldatei (Mappe: Tabelle1) sind zwei Tabellen vorhanden. Der linken Tabellen fehlen Informationen in den Spalten "Listenpreis und Leistung". In der rechten Tabelle befinden sich diese Infos. Sobald ich auf Schaltfläche 1 - Button drücke, wird die linke Tabelle um die Informationen ergänzt, die in der rechten Tabellen enthalten sind. Dabei wird der Modellname geprüft und ob das Baujahr in einer gewissen Spanne befindet. Gerne in der Excel-Datei ausprobieren.
Nun befinden sich in beiden Tabellen nur insgesamt wenige Zeilen/Datensätze. Alles funktioniert einwandfrei! Sobald aber eine Vielzahl an Daten eingefügt werden, stürzt das Programm (Excel) ab und es erfolgt keine Rückmeldung.
Gibt es hierfür eine Lösung? An sich funktioniert das Makro, aber mit zu vielen Daten kommt es nicht zurecht. Hat jemand eine Idee?
Es geht um folgendes Makro:
Sub Zuordnen()
Dim rTab1 As Range, rTab2 As Range
Dim lZeile1 As Long, lZeile2 As Long
Dim Modell
Dim Baujahr As Long
Dim lModellworte As Long
Set rTab1 = ActiveSheet.Range("A1") 'Anpassen (Tabelle1 Erste Zelle Links oben)
Set rTab2 = ActiveSheet.Range("H1") 'Anpassen (Tabelle2 Erste Zelle Links oben)
Set rTab1 = Range(rTab1.End(xlToRight), rTab1.End(xlDown))
Set rTab2 = Range(rTab2.End(xlToRight), rTab2.End(xlDown))
For lZeile1 = 2 To rTab1.Rows.Count
Modell = Split(rTab1(lZeile1, 2))
Baujahr = rTab1(lZeile1, 3)
For lZeile2 = 2 To rTab2.Rows.Count
For lModellworte = LBound(Modell) To UBound(Modell)
If InStr(1, rTab2(lZeile2, 1), Modell(lModellworte), vbTextCompare) = 0 Then _
Exit For
Next lModellworte
If lModellworte = UBound(Modell) + 1 Then
If rTab1(lZeile1, 3) >= rTab2(lZeile2, 3) And rTab1(lZeile1, 3) Viele Grüße
Michael