Microsoft Excel

Herbers Excel/VBA-Archiv

Tabellenabgleich

Betrifft: Tabellenabgleich von: Marco
Geschrieben am: 16.07.2020 13:59:15

Liebe Foren-Gemeinde,

Ich hänge seit Stunden an einer Prozedur und komme einfach nicht weiter.

Ziel ist es die Tabelleninhalte zu vergleichen und die Zeilen zu löschen, die NICHT in der anderen Liste enthalten sind.

Ich habe also ein Tabellenblatt mit allen Kundennummern (Spalte B, ab Zelle B2) und ein Tabellenblatt mit ausgewählten Kundennummern (Spalte A, ab Zelle A3).


Das Tabellenblatt mit allen Kundennummern soll bereinigt werden um die Kunden, die im nicht Tabellenblatt der ausgewählten Kundennummern. Am Ende sollen also in beiden Tabellen die gleichen Kunden enthalten sein.


Ich habe es versucht in zwei Prozeduren aufzuteilen. Die eine soll die NICHT vorhandenen Fälle finden und löschen und die andere soll die Anzahl der Durchlaufe festlegen.


Hier nun mein Versuch in der Hoffnung, dass mir jemand den entscheidenden Tipp geben kann.

Dafür schon mal vielen Dank.


Ich arbeite mit Excel 2016


Liebe Grüße

Marco




Option Explicit


Private Sub KundenVergleich()

Dim Zelle As Range
Dim Kundennummer As String
Sheets("Alle").Select
Kundennummer = ActiveCell.Value

Sheets("ausgewählte").Activate
ActiveSheet.UsedRange.Select

For Each Zelle In Selection

If Zelle.Value <> Kundennummer Then

Zelle.Select
'ActiveCell.EntireRow.Delete

End If
Next Zelle

End Sub


Public Sub Nicht_vorhandene_löschen()


Dim Zeilen As Integer

Dim Counter As Integer


Sheets("Alle").Select

Range("B2").Select


Range(Selection, Selection.End(xlDown)).Select

Zeilen = ActiveWindow.RangeSelection.Rows.Count


Sheets("Alle").Activate

KundenVergleich

For Counter = 2 To Zeilen + 2


KundenVergleich


Sheets("Alle").Activate

Range("B" + CStr(Counter)).Select


Next

End Sub

Betrifft: AW: Tabellenabgleich
von: Hajo_Zi
Geschrieben am: 16.07.2020 14:02:45

Hallo Marco,

ich hätte Fiund benutzt.
    With Worksheets("Projekte")
        Set Rafound = .Columns(4).find("Ha", .Range("D1"), , xlPart, , xlNext)
        ' xlPart enthalten
        ' xlWhole kompletter Vergleich
        If Not Rafound Is Nothing Then
Zu Deiner Datei kann ich nichts schreiben, was wohl daran liegt das ich nicht auf fremde Rechner schaue.Ich baue keine Datei nach.

Sollte die Datei verlinkt werden?

Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten
http://www.ms-office-forum.de/forum/showthread.php?t=322895
änderrn.

Bilder lade ich mir nicht runter, da Excel damit nichts anfangen kann.

http://www.excel-ist-sexy.de/bilder-statt-datei/

Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.

Das ist nur meine Meinung zu dem Thema.

GrußformelHomepage

Betrifft: Lade mal eine Beispielmappe...
von: Werner
Geschrieben am: 16.07.2020 14:04:39

Hallo,

...mit ein paar Spieldaten hier hoch.

Ich würde das mit einer Kombi aus ZÄHLENWENN-Formel und RemoveDuplicates per VBA lösen.

Gruß Werner

Betrifft: AW: Tabellenabgleich
von: Marco
Geschrieben am: 16.07.2020 16:34:31

Hier ist meine Test-Arbeitsmappe. Ist natürlich nur ein Auszug. Normalerweise haben beide Tabellenblätter noch mehrere Spalten und viel mehr Zeilen.

Ich bin für jede Hilfe dankbar.



Link für die Test-Arbeitsmappe:

https://www.herber.de/bbs/user/139115.xlsm

Betrifft: AW: Tabellenabgleich
von: Werner
Geschrieben am: 16.07.2020 17:00:48

Hallo,

so:
Public Sub Nicht_vorhandene_löschen()
Dim loLetzte As Long, loSpalte As Long

Application.ScreenUpdating = False

With Worksheets("Alle")
    loLetzte = .Cells(.Rows.Count, "B").End(xlUp).Row
    loSpalte = .Cells(2, .Columns.Count).End(xlToLeft).Column
    .Range(.Cells(3, "A"), .Cells(loLetzte, "A")).FormulaLocal = _
    "=WENN(ZÄHLENWENN(ausgewählte!A:A;B3);Zeile();0)"
    .Range(.Cells(3, "A"), .Cells(loLetzte, "A")).Value = _
    .Range(.Cells(3, "A"), .Cells(loLetzte, "A")).Value
    .Range("A2") = 0
    .Range(.Cells(1, "A"), .Cells(loLetzte, loSpalte)).RemoveDuplicates _
    Columns:=1, Header:=xlNo
    .Columns("A").ClearContents
End With
End Sub
Es müssen aber im Blatt "Alle" in der Zeile 2 in allen Spalten Überschriften vorhanden sein. Zudem muss, wie in der Beispielmappe im Blatt "Alle" die Spalte A leer sein.

Gruß Werner