Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1564to1568
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 Verknüpfen
14.06.2017 14:41:02
Adem
Hallo zusammen, würde mich sehr freuen wenn ihr mir weiter helfen könntet.
Undzwar hab ich ein folgendes Problem.
Userbild
Ich habe 2 Tabellen einmal "Alle" und einmal "Artikel" mit den Spalten A-T.
Mittels Makro vba code möchte ich die ganze Tabelle "Artikel" mit Tabelle "Alle" vergleichen. Wenn die ID Nummer bei mir die Spalte A bei Tabelle "Artikel" und bei "Alle" vorhanden ist möchte ich das die Zeile bei der Tabelle "Alle" gelöscht wird.
Also bei gleicher ID Nummer soll er die Zeile in der Tabelle "Alle" löschen.
Nach dem löschen soll er die ganze Tabelle"Artikel" bzw. die ganzen Datensätze in "Artikel" in die Tabelle "Alle" unten mit den ganzen Spalten A-T einfügen.

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: 2 Tabellen Verknüpfen
14.06.2017 15:21:11
Piet
Hallo
ich nehme an du weisst wie man ein Makro einfügt. Hier ein Code von mir mit umgekehrter Überlegung!
Wenn ich vorher doppelte Löschen soll um danach unten anzufügen müsste man die Liste auch vorher neu sortieren!
Ich kann die -nicht vorhandenen- aber auch direkt unten anhaengen, indem ich prüfe ob sie -nicht vorkommen-!
Das war meine Übelegung, darauf basiert mein Code. Sollt das falsch sein kann man es aendern.
Ich vergleich die Spalten "A" miteinander. Sollte das falsch sein den Code einfach umschreiben.
Einfach das A in For Each und Set rFind durch einen anderenBuchstaben ersetzen. Das ist alles ....
mfg Piet
Option Explicit      '14.6.2017  Piet  Herber Forum
Sub Vergleichen_einfügen()
Dim AC As Range, rFind As Object
Dim lzAtk As Long, lzAll As Long
Dim All As Worksheet  'Sht "Alle"
Set All = Worksheets("Alle")
'LastZelle in Spalte A im Blatt "Alle"
lzAll = All.Cells(Rows.Count, "A").End(xlUp).Row
With Worksheets("Artikel")
'LastZelle in Spalte A im Blatt "Artikel"
lzAtk = .Cells(Rows.Count, "A").End(xlUp).Row
'Schleife für alle Artikel mit Alle zu vergleichen
For Each AC In .Range("A2:A" & lzAtk)
'Prüfe ob ID-Nummer in Spalte A im Blatt "Alle" schon vorhanden ist?
Set rFind = All.Columns("A").Find(What:=AC, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True)
'wenn Nein unten anfügen  (nicht vorhanden)
If rFind Is Nothing Then
lzAll = lzAll + 1  'lzAll + 1 erhöhen
AC.Resize(1, 20).Copy All.Cells(lzAll, "A")
End If
Next AC
End With
End Sub

Anzeige
AW: 2 Tabellen Verknüpfen
14.06.2017 15:50:05
Adem
Hi, vielen Dank erstmal aber irgendwie funktioniert der Code nicht bei mir. Bei doppelter Id soll er mir die ID mit den ganzen spalten löschen in der Tabelle "Alle". Und am Ende soll er mir die ganze Tabelle"Artikel" in Tabelle "Alle" einfügen damit ich keine doppelte ID habe oder wenn etwas geändert wurde das ich die aktualisierte Id habe.
es kommen immer neue Artikeln in die Tabelle"Artikel" mit 20-30 Datensätzen und ich möchte die ganzen Datensätze in die Tabelle"Alle" einfügen. Irgendwann werde ich aber über 10.000 Datensätze haben und deswegen möchte ich erst die doppelten ID Nummer in Tabelle"Alle" löschen und dann die ganze Tabelle "Artikel" in Tabelle"Alle" einfügen.
Anzeige
AW: 2 Tabellen Verknüpfen
14.06.2017 20:53:40
Werner
Hallo Adem,
hier ein anderer Ansatz mit RemoveDuplicates.
Dazu wird während dem Makrolauf eine Nummerierung der Datensätze im Blatt "Alle" in Spalte U eingefügt (braucht man nur wegen der Sortierung und wird danach wieder entfernt).
Das setzt natürlich voraus, dass dort keine Daten vorhanden sind.
Wenn doch, dann müsste das Makro noch angepasst werden.
Dann aber bitte eine kleine Beispielmappe mit ggf. anonymisierten Beispieldaten.
Kannst ja mal testen.
Public Sub Aktualisieren()
Dim loArtikel As Long 'letzte Zeile Artikel
Dim loAlle As Long 'letzte Zeile Alle
loArtikel = Worksheets("Artikel").Cells(Rows.Count, 1).End(xlUp).Row
loAlle = Worksheets("Alle").Cells(Rows.Count, 1).End(xlUp).Row + 1
Application.ScreenUpdating = False
'alle Daten aus Blatt Artikel in Blatt Alle (unten)
With Worksheets("Artikel")
.Range(.Cells(2, 1), .Cells(loArtikel, 20)).Copy _
Worksheets("Alle").Cells(loAlle, 1)
End With
loAlle = Worksheets("Alle").Cells(Rows.Count, 1).End(xlUp).Row
'Datensätze in Spalte U durchnummerieren
With Worksheets("Alle")
.Range(.Cells(3, 21), .Cells(loAlle, 21)).FormulaLocal = "=ZEILE()-2"
.Range(.Cells(3, 21), .Cells(loAlle, 21)).Value = .Range(.Cells(3, 21), .Cells(loAlle, 21)). _
Value
End With
'Datensätze nach Spalte U absteigend sortieren
Worksheets("Alle").Sort.SortFields.Clear
Worksheets("Alle").Sort.SortFields.Add Key:=Range("U3:U" & loAlle), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With Worksheets("Alle").Sort
.SetRange Range("A3:U" & loAlle)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
Worksheets("Alle").Columns("U:U").ClearContents 'Nummerierung in Spalte U löschen
'Duplicate (Kriterium in Spalte A) entfernen
Worksheets("Alle").Range("A3:T" & loAlle).RemoveDuplicates Columns:=1, Header:=xlNo
'Datensätze nach Spalte A aufsteigend sortieren
Worksheets("Alle").Sort.SortFields.Clear
Worksheets("Alle").Sort.SortFields.Add Key:=Range("A3:A" & loAlle), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Worksheets("Alle").Sort
.SetRange Range("A3:T" & loAlle)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
Application.ScreenUpdating = True
End Sub
Gruß Werner
Anzeige
Feedback ein Fremdwort?
20.06.2017 10:11:41
Werner
Hallo Adem,
eine Antwort deinerseits ist dir mein Beitrag wohl nicht wert.
Gruß Werner
AW: Feedback ein Fremdwort?
24.06.2017 17:34:04
Adem
Hallo Werner,
da ich Samstags arbeite und nicht meine E-Mails kontrolliert hab könnte ich Ihnen keinen Feedback geben, aber mit paar Änderungen hat es super geklappt.
Vielen Dank

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige