|
Hallo,
ich bin neu hier in diesem Forum habe also nicht wirklich Ahnung davon wie das hier funktioniert. Leider beherrsche ich auch VBA nicht wirklcih sondern habe versucht es mir selbst ein wenig anzueignen.
Mein Problem:
Ich habe in Excel 2 Tabellenblätter. Wenn im ersten Tabellenblatt der wert in der 5. spalte mit dem Wert im 2. Tabellenblatt in der 1. spalte übereinstimmt, soll überprüft werden ob einer der werte der spalten 7-10 im ersten Tabellenblatt mit einem der werte in zeile 2-5 in Tabellenblatt2 übereinstimmt. Kurz: stimmt wert in zeile 7 mit wert in zeile 2 ODER stimmt wert in zeile 8 mit wert in zeile 3 etc.... Falls dies der Fall ist, soll anschließen der wert aus spalte 6 in Tabelle2 in spalte 13 in Tabelle 1 geschrieben werden... An sich glaube cih dass mein Code funktioniert, jedoch habe ich riesige Datensätze und wenn cih das Makro laufen lasse, kommt es entweder NIE zum ende oder excel stürzt komplett ab.... kann mir jemand helfen den code umzuschreiben und die performance zu verbessern? Hier mein code
Sub Zuordnung()
On Error GoTo fehler
Dim lz As Long
Dim i As Long
Dim lz_2 As Long
Dim j As Long
'Ermittlung der letzten Zeile
lz = Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Rows.Row
lz_2 = Worksheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Rows.Row
For i = 2 To lz
For j = 2 To lz_2
If Worksheets("Tabelle1").Cells(i, 5).Value = Worksheets("Tabelle2").Cells(j, 1).Value Then
If (Worksheets("Tabelle1").Cells(i, 7).Value = Worksheets("Tabelle2").Cells(j, 2).Value Or Worksheets("Tabelle1").Cells(i, 8).Value = Worksheets("Tabelle2").Cells(j, 3).Value Or Worksheets("Tabelle1").Cells(i, 9).Value = Worksheets("Tabelle2").Cells(j, 4).Value Or Worksheets("Tabelle1").Cells(i, 10).Value = Worksheets("Tabelle2").Cells(j, 5).Value) Then
Worksheets("Tabelle1").Cells(i, 13).Value = Worksheets("Tabelle2").Cells(j, 6).Value
End If
End If
Next j
Next i
Exit Sub
fehler: MsgBox "Fehler in Sub Fehler0" & vbCrLf & "Fehlernummer: " & Err.Number & _
vbCrLf & "Fehlerbeschreibung: " & Err.Description
End Sub
|