Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
408to412
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
408to412
408to412
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Abgleich und zusammenfügen von 2 Tabellenblättern

Abgleich und zusammenfügen von 2 Tabellenblättern
2
Hallo zusammen,
möchte gerne Werte (3 Spalten) aus einem 2. Tabellenblatt in das 1. übernehmen,(weitere Spalten einfügen), wobei jeweils die 1. Spalte die Artikelnummer ist. Dabei soll gleichzeitig geprüft werden, ob alle Artikelnummer aus Tabelle 2 in Tabelle 1 vorhanden sind, wenn nicht in der entsprechenden Zeile ein Hinweis ausgegeben werden.
Wer hat eine IDEE ?
Danke im voraus.
Grüße
ROlf
AW: Abgleich und zusammenfügen von 2 Tabellenblättern
2
Hallo Rolf,
Gruss Beni

Sub Abgleich_und_zusammenfügen()
Sheets(2).Select
For i = 1 To Cells(65536, 1).End(xlUp).Row
Wert = Cells(i, 1)
With Sheets(1).Columns(1)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If C Is Nothing Then
r = Sheets(1).Cells(65536, 1).End(xlUp).Row + 1
Range(Cells(i, 1), Cells(i, 3)).Copy Destination:=.Cells(r, 1)
.Cells(r, 4) = "fehlt"
End If
End With
Next i
End Sub

AW: Abgleich und zusammenfügen von 2 Tabellenblättern
2
Hallo Beni,
danke Dir für Deine Antwort. Nur:
Ist es möglich, daß der Code nur kopiert falls es Unterschiede gibt ?
Es passiert nämlich nichts sichtbares.
Gruß
ROlf
Anzeige
AW: Abgleich und zusammenfügen von 2 Tabellenblättern
2
Hallo Rolf,
dieser Code kontrolliert die Datensätze, wenn Unterschiede, passt er sie an und vermerkt in SpalteD, in welcher Spalte der Unterschied war, wenn nicht vorhanden, fügt er sie hinzu.
Gruss Beni

Sub Abgleich_und_zusammenfügen()
Sheets(2).Select
For i = 1 To Cells(65536, 1).End(xlUp).Row
Wert = Cells(i, 1)
With Sheets(1).Columns(1)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If C Is Nothing Then
r = Sheets(1).Cells(65536, 1).End(xlUp).Row + 1
Range(Cells(i, 1), Cells(i, 3)).Copy Destination:=.Cells(r, 1)
.Cells(r, 4) = "fehlt"
Else
If C(1, 2) <> Cells(i, 2) Then Cells(i, 2).Copy Destination:=C(1, 2): C(1, 4) = "2"
If C(1, 3) <> Cells(i, 3) Then Cells(i, 3).Copy Destination:=C(1, 3): C(1, 4) = "3"
End If
End With
Next i
End Sub

Anzeige
AW: Abgleich und zusammenfügen von 2 Tabellenblättern
2
Hallo Beni,
fast perfekt.
Funktioniert leider nur nicht bei einer unsortierten Tabelle Blatt2, heisst Reihenfolgen Blatt1 (A1:An) ungleich Blatt2(A1:An). Auch werden beim Einfügen der Spalten aus Blatt2 die Spalten der Tabelle Blatt1 an dieser Stelle überschrieben. Das ist schlecht, die benötige ich nämlich noch.
Noch eine Idee ?
Danke und Gruß
ROlf
AW: Abgleich und zusammenfügen von 2 Tabellenblättern
2
Hallo Rolf,
jetzt werden die Unterschiede nur noch angezeigt.
Gruss Beni

Sub Abgleich_und_zusammenfügen()
Sheets(2).Select
For i = 1 To Cells(65536, 1).End(xlUp).Row
Wert = Cells(i, 1)
With Sheets(1).Columns(1)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If C Is Nothing Then
r = Sheets(1).Cells(65536, 1).End(xlUp).Row + 1
Range(Cells(i, 1), Cells(i, 3)).Copy Destination:=.Cells(r, 1)
.Cells(r, 4) = "fehlt"
Else
If C(1, 2) <> Cells(i, 2) Then C(1, 4) = "2"
If C(1, 3) <> Cells(i, 3) Then C(1, 4) = "3"
End If
End With
Next i
End Sub

Anzeige
Leider nein : Abgleich und zusammenfügen
09.04.2004 20:48:59
ROlf
Hallo Beni,
Vielen Dank für Deine Mühe, aber wir reden hier leider am Thema vorbei. Der 2. Ansatz war schon sehr,sehr gut. Wie gesagt das kopieren überschreibt die Spalten 1(2-3) das soll nicht sein. Was passiert bei einer abweichenden Artikelnummersortierung in Blatt2 ?
Gruß
ROlf

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige