Tabellen vergleichen
26.02.2008 12:18:43
Manfred
ich habe hier im Forum diesen kleinen CODE gefunden, er läuft zwar, nun komme ich aber nicht weiter. Hunderte von vergleichen von Tabellen, aber keiner passt so richtig zum umbauen. Ich hoffe hier gibt es Hilfe.
https://www.herber.de/bbs/user/50192.xls
In Zeile 1 von Tab1 und Tab2 stehen die Überschriften.
In Tab1 und Tab2, in Sp.A stehen laufende Nummern, in Sp.B stehen die Personalnummern; in Sp.C die Namen
Er vergleicht Tab1, SpB mit Tab2, SpB , bei Gleichheit überträgt er die Namen aus Tab1, SpC nach Tab2, SpC.
Ist ein Name bei Gleichheit nach Tab2, SpC übertragen worden, darf dieser beim nächsten Lauf nicht wieder überschrieben od. mit einer leeren Zelle ersetzt werden. Tab1 ändert sich wöchentlich dann werden nur noch Personalnummern und Punkte in unbekannter Reihenfolge eingegeben.
Mein Problem.
Kann man den CODE so umbauen daß er die Namen in den nächsten Läufen in Tab2, SpC nicht überschreibt od. durch eine leere Zelle ersetzt ?
Kann man den CODE so umbauen das ich auch Spalte D separat übertragen kann ?
Dh. Er vergleicht Tab1, SpB mit Tab2, SpB , bei Gleichheit überträgt es die PUNKTE aus Tab1, SpD nach Tab2, SpD.
Sub Namen_mit_Pnr_Vergl_und_Uebernehmen()
Dim vntX, vntY, lngX As Long, lngY As Long, intCol As Integer
vntX = Sheets("Tabelle2").Range("a1").CurrentRegion
vntY = Sheets("Tabelle1").Range("a1").CurrentRegion
For lngX = 2 To UBound(vntX, 1)
For lngY = 2 To UBound(vntY, 1)
If vntX(lngX, 2) = vntY(lngY, 2) Then 'vergleicht Tab1, Sp.B mit Tab2, Sp.B
For intCol = 3 To 3 war von Spalte 3 13 eingestelt
vntX(lngX, intCol) = vntY(lngY, intCol) Laufzeitfehler 9, wenn ich For _
intCol = 4 To 4 eingebe, also nach Tab2 Sp.D übertrage Next
End If
Next lngY
Next lngX
Sheets("Tabelle2").Range("a1").CurrentRegion = vntX
End Sub
Mit freundlichen Grüßen
Manfred