Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1400to1404
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
2 Tabellen abgleichen
05.01.2015 21:09:55
Peter
Hallo,
ich möchte die Spalte 3 in den Tabellen "D" und "B" vergleichen. Bei Übereinstimmung wird von der entspr. Zeile, der Spaltenbereich " L bis Z" von Tabelle "D" in die Tabelle "B" eingefügt.
Bis hier OK.
Im nächsten Schritt sollen wieder die Spalte 3 in den Tabellen "D" und "B" verglichen werden.
Bei NICHT-Übereinstimmung sollen diese Zeilen in die Tabelle "A" eingefügt werden und zum Schluss alle nichtleeren Zeilen in der Tabelle "D "gelöscht werden.
-siehe auch Anlagedatei-
https://www.herber.de/bbs/user/94769.xls
Vielen Dank im voraus
Peter

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: 2 Tabellen abgleichen
06.01.2015 12:52:32
Klaus
Hallo Peter,
folgener Code funktioniert in deiner Musterdatei:
Option Explicit
Sub TabellenAbgleichen()
'Spalte 3 aus "B" und "D" vergleichen.
'Bei Gleichheit Inhalt aus "D" in "B" einfügen.
'Sonst Inhalt aus "D" in "A" einfügen.
'Inhalt D löschen
Const SpalteAb As Long = 12    'von Spalte L
Const SpalteBis As Long = 26   'bis Spalte Z
Const SpalteVergleich As Long = 3  'in Spalte C vergleichen
Const ZeileAb As Long = 2      'in Zeile 1 stehen überschriften
Dim ShZ As Worksheet, ShQ As Worksheet, ShA As Worksheet
Set ShQ = Worksheets("D")
Set ShZ = Worksheets("B")
Set ShA = Worksheets("A")
Dim ZeileBis As Long
Dim r As Range
Dim ZeileRein As Long
Dim ZeileLetzteA
With ShA 'freie Zeile in A feststellen
ZeileLetzteA = .Cells(.Rows.Count, SpalteVergleich).End(xlUp).Row
End With
With ShQ
'letzte Zeile feststellen
ZeileBis = .Cells(.Rows.Count, SpalteVergleich).End(xlUp).Row
'Alle Zeilen durchgehen
For Each r In .Range(.Cells(ZeileAb, SpalteVergleich), .Cells(ZeileBis, SpalteVergleich))
'Kommt ArtNr in B vor?
If WorksheetFunction.CountIf(Sheets("B").Cells(1, SpalteVergleich).EntireColumn, r. _
Value) = 1 Then
.Range(.Cells(r.Row, SpalteAb), .Cells(r.Row, SpalteBis)).Copy
ShZ.Cells(WorksheetFunction.Match(r.Value, ShZ.Cells(1, SpalteVergleich). _
EntireColumn, False), SpalteAb).PasteSpecial
Application.CutCopyMode = False
Else 'oder nicht?
ZeileLetzteA = ZeileLetzteA + 1
.Cells(r.Row, SpalteAb).EntireRow.Copy
ShA.Cells(ZeileLetzteA, 1).PasteSpecial
End If
'Zeileninhalt löschen
.Cells(r.Row, 1).EntireRow.ClearContents
Next r
End With
Grüße,
Klaus M.vdT.

Anzeige
AW: 2 Tabellen abgleichen
08.01.2015 21:27:10
Peter
Vielen Dank.
Du hast mir sehr weitergeholfen.
Peter

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige