Vergleich zweier Tabellenblätter VBA

Liebes Forum-Team,
ich habe zwei Tabellenblätter, welche ich vergleichen möchte. Als Vergleichsparameter dient die Personalnummer. Es soll nachgesehen werden, welche Personen eine Maschine haben und diese NICHT benötigen und welche eine benötigen aber KEINE haben. (fiktives Beispiel)
Tabellenblatt 1 (benötigen diese Maschine):
Personalnummer(A1) Vorname(B1) Nachname(C1)
11 Max Mustermann
12 Heinz Huber
13 Lukas Lust
Tabellenblatt 2 (haben diese Maschine):
Personalnummer(A1) Vorname(B1) Nachname(C1)
11 Max Mustermann
14 Sarah Selten
13 Lukas Lust
Output in einem dritten Tabellenblatt
Personen die eine benötigen und keine haben:
Personalnummer(A1) Vorname(B1) Nachname(C1)
12 Heinz Huber
Personen die eine haben aber keine benötigen:
Personalnummer(E1) Vorname(F1) Nachname(G1)
14 Sarah Selten
Ich hoffe ich war nicht zu verwirrend :D
Ich bedanke mich vielmals im Voraus :)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo themanwhoneedshelp,
ich denke, dass der nachfolgende Code macht, was du moechtest. Code in ein allgemeines Modul:


Option Explicit
Sub Finden()
Dim wsNeed As Worksheet, wsHave As Worksheet, wsResult As Worksheet
Dim lngLast1 As Long, lngLast2 As Long, lngLast3 As Long, lngRow As Long
Set wsNeed = ThisWorkbook.Sheets("Tabelle1")
Set wsHave = ThisWorkbook.Sheets("Tabelle2")
Set wsResult = ThisWorkbook.Sheets("Tabelle3")
lngLast1 = wsNeed.Cells(Rows.Count, 1).End(xlUp).Row
lngLast2 = wsHave.Cells(Rows.Count, 1).End(xlUp).Row
lngLast3 = wsResult.Cells(Rows.Count, 1).End(xlUp).Row
wsResult.Range("A2:G" & lngLast3).ClearContents
For lngRow = 2 To lngLast1
lngLast3 = wsResult.Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIfs(wsHave.Columns(1), wsNeed.Cells(lngRow, 1)) = 0 Then
wsNeed.Range("A" & lngRow & ":C" & lngRow).Copy wsResult.Range("A" & lngLast3 + 1)
End If
Next lngRow
For lngRow = 2 To lngLast1
lngLast3 = wsResult.Cells(Rows.Count, 5).End(xlUp).Row
If WorksheetFunction.CountIfs(wsNeed.Columns(1), wsHave.Cells(lngRow, 1)) = 0 Then
wsHave.Range("A" & lngRow & ":C" & lngRow).Copy wsResult.Range("E" & lngLast3 + 1)
End If
Next lngRow
End Sub

Wie du das Makro startest, musst du selbst entscheiden.
Gruss Tor

Option Explicit Sub Finden() Dim wsNeed As Worksheet, wsHave As Worksheet, wsResult As Worksheet Dim lngLast1 As Long, lngLast2 As Long, lngLast3 As Long, lngRow As Long Set wsNeed = ThisWorkbook.Sheets("Tabelle1") Set wsHave = ThisWorkbook.Sheets("Tabelle2") Set wsResult = ThisWorkbook.Sheets("Tabelle3") lngLast1 = wsNeed.Cells(Rows.Count, 1).End(xlUp).Row lngLast2 = wsHave.Cells(Rows.Count, 1).End(xlUp).Row lngLast3 = wsResult.Cells(Rows.Count, 1).End(xlUp).Row wsResult.Range("A2:G" & lngLast3).ClearContents For lngRow = 2 To lngLast1 lngLast3 = wsResult.Cells(Rows.Count, 1).End(xlUp).Row If WorksheetFunction.CountIfs(wsHave.Columns(1), wsNeed.Cells(lngRow, 1)) = 0 Then wsNeed.Range("A" & lngRow & ":C" & lngRow).Copy wsResult.Range("A" & lngLast3 + 1) End If Next lngRow For lngRow = 2 To lngLast2 lngLast3 = wsResult.Cells(Rows.Count, 5).End(xlUp).Row If WorksheetFunction.CountIfs(wsNeed.Columns(1), wsHave.Cells(lngRow, 1)) = 0 Then wsHave.Range("A" & lngRow & ":C" & lngRow).Copy wsResult.Range("E" & lngLast3 + 1) End If Next lngRow End Sub

Beliebteste Forumthreads (12 Monate)

Vergleich zweier Tabellenblätter VBA

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

195 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Vergleich zweier Tabellenblätter VBA

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

195 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread