ich stehe vor dem Problem eine "ewige" Kundenliste (liste) und eine "aktuelle" (temp) miteinander vergleichen zu wollen, stimmen sie überein, ist es ok, fehlt jemand in der "liste", wird er/sie hinzugefügt, ist jemand von der Liste nicht mehr aktuell wird die Zeile markiert. Das funktioniert mit unten stehendem Code, leider birgt er zwei Probleme:
1. Es dauert relativ lange, daraus schließe ich dass meine Methode "unelegant" ist
2. Bei gleichlautenden Nachnamen findet der Code nur den ersten in der Liste (dann wird Vorname, GebDat... verglichen), also ist das Ergebnis nicht notwendigerweise richtig, ich habe aber mit FindNext nichts ordentliches zusammengebracht.
Der Code:
For z = 2 To anz
svnr = temp.Cells(z, 4).Value
gtag = temp.Cells(z, 5).Value
gmon = temp.Cells(z, 6).Value
gjah = temp.Cells(z, 7).Value
nnam = temp.Cells(z, 8).Value
vnam = temp.Cells(z, 10).Value
liste.Select
liste.Columns("F:F").Select
On Error GoTo neuer:
fund = Selection.Find(What:=nnam, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Row
If liste.Cells(fund, 7).Value = vnam And liste.Cells(fund, 2).Value = svnr And liste.Cells(fund, 3).Value = gtag And liste.Cells(fund, 4).Value = gmon And liste.Cells(fund, 5).Value = gjah Then
liste.Cells(fund, 17).Value = 1
Else
lianz = liste.Cells(8, 1).CurrentRegion.Rows.Count
zeil = lianz + 7
liste.Cells(zeil, 6).Value = temp.Cells(z, 8).Value
liste.Cells(zeil, 7).Value = temp.Cells(z, 10).Value
liste.Cells(zeil, 1).Value = temp.Cells(z, 3).Value
liste.Cells(zeil, 2).Value = temp.Cells(z, 4).Value
liste.Cells(zeil, 3).Value = temp.Cells(z, 5).Value
liste.Cells(zeil, 4).Value = temp.Cells(z, 6).Value
liste.Cells(zeil, 5).Value = temp.Cells(z, 7).Value
liste.Cells(zeil, 8).Value = temp.Cells(z, 16).Value
liste.Cells(zeil, 9).Value = temp.Cells(z, 18).Value
liste.Cells(zeil, 10).Value = temp.Cells(z, 19).Value
liste.Cells(zeil, 11).Value = temp.Cells(z, 20).Value
liste.Cells(zeil, 12).Value = temp.Cells(z, 21).Value
liste.Cells(zeil, 13).Value = temp.Cells(z, 23).Value
liste.Cells(zeil, 14).Value = temp.Cells(z, 24).Value
liste.Cells(zeil, 16).Value = "NEU"
End If
Next z
liste.Activate
Range("A8").Select
anz = ActiveCell.CurrentRegion.Rows.Count
For z = 8 To anz
If liste.Cells(z, 17).Value = "" And liste.Cells(z, 16).Value <> "NEU" Then
Range(Cells(z, 1), Cells(z, 16)).Interior.Color = RGB(255, 255, 0)
liste.Cells(z, 16).Value = "WEG"
End If
Next z
Exit Sub
neuer:
lianz = liste.Cells(8, 1).CurrentRegion.Rows.Count
zeil = lianz + 7
liste.Cells(zeil, 6).Value = temp.Cells(z, 8).Value
liste.Cells(zeil, 7).Value = temp.Cells(z, 10).Value
liste.Cells(zeil, 1).Value = temp.Cells(z, 3).Value
liste.Cells(zeil, 2).Value = temp.Cells(z, 4).Value
liste.Cells(zeil, 3).Value = temp.Cells(z, 5).Value
liste.Cells(zeil, 4).Value = temp.Cells(z, 6).Value
liste.Cells(zeil, 5).Value = temp.Cells(z, 7).Value
liste.Cells(zeil, 8).Value = temp.Cells(z, 16).Value
liste.Cells(zeil, 9).Value = temp.Cells(z, 18).Value
liste.Cells(zeil, 10).Value = temp.Cells(z, 19).Value
liste.Cells(zeil, 11).Value = temp.Cells(z, 20).Value
liste.Cells(zeil, 12).Value = temp.Cells(z, 21).Value
liste.Cells(zeil, 13).Value = temp.Cells(z, 23).Value
liste.Cells(zeil, 14).Value = temp.Cells(z, 24).Value
liste.Cells(zeil, 16).Value = "NEU"
Resume Next
End Sub
Bin dankbar für jede Anregung
Gruß
Christian