Guten Tag,
Zum Sachverhalt ich bekomme Quartalsweise eine gesamt Personalliste diese muss ich in einer anderen Tabelle einlesen, da diese Übersicht mittlerweile
über 500 Datensätze enthält ist das Vergleichen per Hand sehr aufwendig.
Ich würde gern diese beiden Tabellen per VBA mit einander Vergleichen, hierbei sollen neue Daten am ende der Tabelle eingefügt werden und abweichende Daten z.B. gelöscht oder geändert
sollen farblich markiert werden.
Ich hoffe Ihr könnt mir weiterhelfen.
Gruß
David
Bitte Beispieldatei - kein Bild - anhängen
Danke
Oh da muss ich eine Beispieltabelle bauen da die Original Tabelle dem Datenschutz unterliegt.
Angehangen die Beispiel Tabelle ich hoffe die reicht so aus ich musste allerdings alle Namen raus nehmen.
Also in der Tabelle wird in dem Reiter Alpha-Liste die gesamt Personalliste eingelesen und dient als Bezug für die Gesamte Tabelle.
Das wichtigste ist der Reiter EVA hier müssen alle Daten der Alpha liste auftauchen, diese wird Quartalsweise aktualisiert. Dementsprechend
muss die EVA liste auch angepasst werden, wichtig hierbei das nicht einfach Daten gelöscht werden da die eingetragenen Daten in der EVA Liste
3 Jahre bestand haben. Sprich tauchen in der Alpha liste gewisse PersNr´n nicht mehr auf so sollen diese in der EVA liste Rot markiert werden.
Tauchen in de Alphaliste neue PersNr´n auf so sollen diese einfach ans ende der EVA liste gestellt werde.
Bitte nicht wundern in den Reitern sind zum teil noch Schaltflächen und Makros von der eigentlichen Tabelle bitte einfach ignorieren.
Gruß
David
Hi,
so?
Code:
Option Explicit
Sub vergleic()
Dim ListEva
Dim Listalfa
Dim intI As Integer
Dim intJ As Integer
Dim SuchNr
Dim stimmt As Boolean
Dim Plus As Integer
Dim Ende As Integer
' suchen nach gefülltem Ende in Eva
Ende = ThisWorkbook.Sheets("EVA").Cells(Rows.Count, 1).End(xlUp).Row
'Aufgabenstellung fehlende in Alfa rot zu markieren
Plus = 1
ListEva = ThisWorkbook.Sheets("EVA").Cells(4, 1).CurrentRegion
Listalfa = ThisWorkbook.Sheets("Alpha-Liste").Cells(4, 1).CurrentRegion
For intI = 4 To Ende
SuchNr = ListEva(intI, 1)
stimmt = 0
For intJ = 3 To UBound(Listalfa)
If SuchNr = Listalfa(intJ, 2) Then
stimmt = 1
Exit For
Else
End If
Next intJ
If intJ = UBound(Listalfa) + 1 And stimmt = 0 Then
ThisWorkbook.Sheets("EVA").Cells(intI, 1).Font.Color = -16776961
End If
Next intI
'Aufgabenstellung fehlende in Eva unten zu ergänzen
For intJ = 3 To UBound(Listalfa)
SuchNr = Listalfa(intJ, 2)
stimmt = 0
For intI = 4 To Ende
If SuchNr = ListEva(intI, 1) Then
stimmt = 1
Exit For
Else
End If
Next intI
If intI = Ende + 1 And stimmt = 0 Then
ThisWorkbook.Sheets("EVA").Cells(Ende + Plus, 1) = SuchNr
Plus = Plus + 1
End If
Next intJ
End Sub
Super vielen dank macht genau das was es soll.
Ich habe doch noch ein kleines Problem festgestellt wenn ich das Tabellenblatt Schütze kann ich das Makro nicht mehr verwenden.
Na, dann hebe den Schutz programmatisch temporär auf und setze ihn zum Schluss wieder.
Alternative:
Setze den Schutz im Workbook_Open mit dem Parameter UserInterfaceOnly:=True
Gruß Ralf