Hallo! Da war noch ein kleiner Fehler. Die Bildschirmaktualisierung am Ende wurde nicht wieder eingeschaltet. Hier geändert. VG
Private Sub CommandButton1_Click()
Dim tab1
Dim tab2
Dim lspalte As Long 'Spalte in Tabelle 2
Dim pspalte As Long 'Spalte in Tabelle 1
Dim azeile As Long 'Zeile in Tabelle 2
Dim bzeile As Long 'Zeile in Tabelle 1
Dim spaltenanfang As Long 'ist der Anfang der Spalten hier Spalte 13
Dim zeilenanfang As Long 'ist der Anfang der Zeilen hier Zeile 52
Dim zeilenende As Long
Dim spaltenende As Long
'erstmal die Bildschirmaktualisierung ausschalten , man könnte ggf. noch mehr aussschalten, das sollte erstmal reichen
Application.ScreenUpdating = False
'allgemeine Werte
spaltenanfang = 13
spaltenende = 263
zeilenanfang = 52
zeilenende = 251
'die Eintragungen in den Zwischenspeicher
tab1 = Tabelle1.Range(Tabelle1.Cells(1, 1), Tabelle1.Cells(zeilenende, spaltenende)) '263
tab2 = Tabelle2.Range(Tabelle2.Cells(1, 1), Tabelle2.Cells(zeilenende, spaltenende))
For pspalte = spaltenanfang To spaltenende
'durch alle Spalten in Tabelle 1 gehen, in Spalte 13 startn
For lspalte = spaltenanfang To spaltenende
'durch alle Spalten in Tabelle 2 gehen
If tab2(5, lspalte) = tab1(5, pspalte) Then
'Mitarbeiter wurde gefunden, der kommt später nicht nochmal, also nach dem Abarbeiten die Schleife in Tabelle 2 verlassen
'jetzt bei dem Mitarbeiter die ersten Werte kopieren, könnte man noch in eine Schleife auslagern
tab1(5, pspalte) = tab2(5, lspalte)
tab1(7, pspalte) = tab2(7, lspalte)
tab1(8, pspalte) = tab2(8, lspalte)
tab1(9, pspalte) = tab2(9, lspalte)
tab1(10, pspalte) = tab2(10, lspalte)
tab1(11, pspalte) = tab2(11, lspalte)
tab1(14, pspalte) = tab2(14, lspalte)
tab1(15, pspalte) = tab2(15, lspalte)
tab1(17, pspalte) = tab2(17, lspalte)
For bzeile = zeilenanfang To zeilenende
'jetzt noch von Zeile 52 bis 251 die Zeilen durchgehen und in Spalte 5 die Werte vergleichen, in Tabelle 1 starten
For azeile = zeilenanfang To zeilenende
'prüfen ob die Eintragungen identisch in der Zeile sind
If tab2(azeile, 5) = tab1(bzeile, 5) Then
tab1(bzeile, pspalte) = tab2(azeile, lspalte)
End If
Next azeile
Next bzeile
Exit For 'beendet die Schleife und geht in die nächse pspalte
End If
Next lspalte
Next pspalte
'die geänderten Eintragungen zurück
Tabelle1.Range(Tabelle1.Cells(1, 1), Tabelle1.Cells(251, 156)) = tab1
Application.ScreenUpdating = True
End Sub
|