Vergleich zweier Tabellenblätter VBA

themanwhoneedshelp · 2021-03-23T09:19:15+00:00

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 :)

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

Sorry, kleiner Fehler drin. Nochmal:


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

Vergleich zweier Tabellenblätter VBA

Forumthread: Vergleich zweier Tabellenblätter VBA

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Vergleich zweier Tabellenblätter VBA

Forumthread: Vergleich zweier Tabellenblätter VBA

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread