Fehlende Finden und Ergänzen / löschen

Guten Morgen!!!
Habe 2 Tabellen die miteinander verglichen und ergänzt werden sollen.
Sheet "Tabelle" enthält in Spalte C Namen , in Sheet "IMPORT" in Spalte A ebenfalls Namen.
Nun soll Sheet "Tabelle" mit Sheet "Import" abgeglichen werden und fehlende Namen UND Gruppe (Spalte B) in Sheet "Tabelle" ergänzt werden.
Danach soll Sheet Tabelle mit Sheet Import verglichen werden und nicht vorhandene Namen in Sheet Import in Sheet Tabelle gelöscht werden OHNE die Anzahl der Zeilen oder das Aussehen der Tabelle zu verändern.
Hab ne Beispieltabelle mit angefügt ind der Mehr Namen im Sheet Import sind und ein Name fehlt.
https://www.herber.de/bbs/user/133785.xlsx
Wäre toll wenn mir jemand helfen könnte!
Schönen Sonntag euch allen noch
Greetz Gerhard

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Gerhard,
so?

Option Explicit

Public Sub Abgleichen()
    Dim avntValues As Variant
    Dim ialngIndex As Long
    Dim objCell As Range
    With Worksheets("IMPORT")
        avntValues = .Range(.Cells(2, 1), .Cells(.Rows.Count, 2).End(xlUp)).Value2
    End With
    With Worksheets("Tabelle")
        For ialngIndex = LBound(avntValues) To UBound(avntValues)
            Set objCell = .Columns(3).Find(What:=avntValues(ialngIndex, 1), _
                LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If objCell Is Nothing Then
                .Cells(.Rows.Count, 3).End(xlUp).Offset(1, 0).Resize(1, 2).Value = _
                    Array(avntValues(ialngIndex, 1), avntValues(ialngIndex, 2))
            Else
                Set objCell = Nothing
            End If
        Next
    End With
    With Worksheets("Tabelle")
        avntValues = .Range(.Cells(3, 3), .Cells(.Rows.Count, 3).End(xlUp)).Value2
    End With
    With Worksheets("IMPORT")
        For ialngIndex = LBound(avntValues) To UBound(avntValues)
            Set objCell = .Columns(1).Find(What:=avntValues(ialngIndex, 1), _
                LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If objCell Is Nothing Then
                Worksheets("Tabelle").Cells(ialngIndex + 2, 3).Resize(1, 2).Value = Empty
            Else
                Set objCell = Nothing
            End If
        Next
    End With
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Fehlende Finden und Ergänzen / löschen

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Fehlende Finden und Ergänzen / löschen

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

301 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