Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Zwei Tabellen vergleichen und zusammenfügen mit Datenübernahme aus jeder der beiden.





Frage

Hallo, seit Tagen versuche ich über Internet Hilfe zu finden und habe dabei Vieles ausprobiert und auch teils nützliche Tipps aus diesem Forum erfahren. Ich komme aber einfach nicht weiter, bin hier einfach ans Ende meines Excellateins geraten. Mit Formeln läßt sich ja vieles anstellen, aber ich komme so nicht ans Ziel. Mit VBA glaube ich könnte es klappen, bin aber nur geübter Laie. Hier mal kurz ein paar Fakten: Tab1 und Tab2 sollen anhand zweier Schlüsselspalten verglichen und in einer neuen Tabelle zusammengeführt werden. Bei gleichen Werten in den Schlüsselspalten sind beide Zeilen zu einer neuen mit den Werten beider Tabellen zu verbinden. Bei Zeilen, die nicht in der jeweils anderen Tabelle vorhanden sind, sollen ebenfalls die Werte dieser Tabelle in die neue Tabelle eingefügt werden. Bezug nehmend der ersten beiden Spalten möchte ich vergleichen. Beispiel: Tab1 10 aa Meier 11 ab Müller 11 aw Schmidt 12 ac Schulz 14 ae Weber 15 af Wendt Tab2 10 aa 635737 10 ab 46786 11 ab 58585 12 ac 58546 13 ae 336546 15 af 345643 Tab3 10 aa Meier 635737 10 ab 46786 11 ab Müller 58585 11 aw Schmidt 12 ac Schulz 58546 13 ae 336546 14 ae Weber 15 af Wendt 345643 Ich bin mir mittlerweile nicht mehr sicher ob es überhaupt machbar ist. Bin aber für jede Anregung dankbar die mich ein Stück vorwärts bringt. Gruß Lufti

Antwort 1 von want2cu

Hallo Lufti,

hier im Bereich EXCEL wurden zu diesem Thema in der Vergangenheit etliche Anfragen gestellt. Es gab auch zu jeder Anfrage eine funktionierende Lösung. Wenn du mal ein wenig hier suchst, wirst du bestimmt eine für dich passende Lösung finden.

CU
want2cu

Antwort 2 von Lufti

Hallo want2cu,

ich habe etliches zum vergleichen gefunden aber kaum was zum kopieren. Und somit komme ich weiterhin zu keiner Lösung, weil ich damit nichts aus verschiedenen Themen zusammen stellen kann.

Gruß Lufti.

Antwort 3 von Frank1

@want:

Zitat:
hier im Bereich EXCEL wurden zu diesem Thema in der Vergangenheit etliche Anfragen gestellt. Es gab auch zu jeder Anfrage eine funktionierende Lösung. Wenn du mal ein wenig hier suchst, wirst du bestimmt eine für dich passende Lösung finden.


meinst Du, daß so ne Antwort hilfreich ist? Aus meiner Sicht ist das eher Verkackern...

@Lufti: Das ganze noch mal ins Access-Board - Excel ist dafür mit Sicherheit nicht die Lösung. Du willst nen Schlüssel über mehr als ein Feld legen (soweit ich das verstanden habe) das ist eher ne Funktion von ner Datenbank und nicht von ner Kalku
naja und so weiter...

mfg frank


Antwort 4 von nighty

hi alle :)

wozu nun acces ?

bei den minidaten ?

@frank
die grenzen was excel kann oder nicht kann,sind wohl eher den phantasie grenzen der user ausgesetzt
want2cu hat da schon recht,hilfe zur selbsthilfe ist das motto eines forums.da diese thematik wirklich in letzter zeit oft vorkam,sind auch alle codes vorhanden und in kurzer zeit zu ermitteln und seinen wuenschen anzupassen.wenn du zum beispiel in acces in einem monat 6 aehnliche loesungen erarbeitet hast wuerdest du aehnlich reagieren,wohl eher eine sache der position und erfahrungswerte.

@Lufti
loesung folgt

gruss nighty

Antwort 5 von want2cu

Hallo Frank1,

ich halte es nicht für unziemlich, darauf hinzuweisen, wenn zu einem nahezu identischen Problem hier im Forum vor kurzem bereits Anfragen da waren und auch erfolgreich gelöst wurden.

Mein Posting war weder unfreundlich noch belehrend. Ich hatte eben nur nicht die Zeit, selber zu suchen und eine fertige Komplettlösung anzubieten.

Deine Auffassung finde ich umso merkwürdiger, weil dein eigener Beitrag m.E. deutlich weniger hilfreich und unkonkret ist. Wenn ich auf konkrete Lösungen im Excel-Board hinweise, wieso ist das dann weniger hilfreich als dein pauschaler Hinweis, die Sache besser mit ACCESS zu lösen und im Access-Borad zu posten???

Merkwürdige Ansicht :-(

CU
want2cu

Antwort 6 von nighty

hi Lufti :)

wie gewuenscht :)

sheet(1) muss aktiv sein,sheet3 wird befuellt :)

gruss nighty

p.s.
mal wieder ein gelungenes makro so glaub ich :)))

Option Explicit
Sub liste_erstellen()
Dim zaehler1, zaehler2, zaehler3, zaehler4
Dim suche1 As Range
With Worksheets(3)
.Range("A1:C65535").Clear
For zaehler1 = 1 To Workbooks(1).Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
.Cells(zaehler1, 1).Value = Cells(zaehler1, 1).Value
.Cells(zaehler1, 2).Value = Cells(zaehler1, 2).Value
Next zaehler1
zaehler2 = Sheets(3).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
zaehler4 = Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
For zaehler1 = 1 To zaehler2
Set suche1 = Worksheets(2).Range("A1:A65535").Find(Worksheets(3).Cells(zaehler1, 1).Value)
If Not suche1 Is Nothing Then
.Cells(zaehler1, 3).Value = Sheets(2).Cells(suche1.Row, 2).Value
End If
Next zaehler1
For zaehler1 = 1 To zaehler4
If Sheets(2).Cells(zaehler1, 1).Value <> "" And Sheets(2).Cells(zaehler1, 2).Value = "" Then
.Cells(zaehler2 + zaehler3, 1).Value = Sheets(2).Cells(zaehler1, 1).Value
zaehler3 = zaehler3 + 1
End If
Next zaehler1
End With
End Sub



Antwort 7 von nighty

hi alle :)

ich wuerde excel vielleicht nicht mehr benutzen wenn der makrocode 200 oder mehr seiten waeren,doch so ist es doch recht klein,und schnell :)))

und auf 65535 zeilen ausgelegt mit kommpletter automatischer abtastung aller drei tabellen,wo ist da was ungeeignet :)))

gruss nighty

Antwort 8 von Lufti

Hallo und dankeschön für das rege Interesse an alle, dann noch ein spezielles Danke an nighty. Habe den gestriegen Tag damit verbracht dein Makro auszuprobieren und dabei leider festgestellt, dass auf Tab 3 einige Dinge fehlen, z.B. die Zeilen die nur in Tab 1 vorkommen bzw. die Spalte mit den Namen und 5-6 stelligen Zahlen.
Ich komme selber aber auch nicht weiter. Bei bedarf kann ich die Beispieldatei auch per Mail verschicken.

Im Augenblick sieht Tab 3 so aus:

10 aa ab
10 ab ab
11 ab ab
12 ac ac
13 ae ae
15 af af

Wie gesagt so wärs perfeckt:

10 aa Meier 635737
10 ab _______46786
11 ab Müller 58585
11 aw Schmidt
12 ac Schulz 58546
13 ae _______336546
14 ae Weber
15 af Wendt 345643

Ich hoffe es macht nicht zuviel Mühe. Am Ende wenn es klappt möchte ich damit 15000 Datensätze in 2 Tabellen mit 5-7 Spalten verleichen und unregelmäßigkeiten herausfinden.
Bitte schreibe mir per Mail an lufti@o2online.de ob du noch Angaben oder die Datei benötigst. Bin sonst erst Sonntag Abend oder Montag wieder im WWW, heute ist es aber auch noch kein Problem.
Dank nochmals und
Grüße, Lufti.


Antwort 9 von nighty

hi lufti :)

schick die tabelle :)

gruss nighty

Antwort 10 von nighty

hi lufti :)

1% einer tabelle(sheet) waeren 167119,35 zellen

daher liegst du wohl eher im kommabereich :))

gruss nighty

p.s.
65537 zeilen
255 spalten

Antwort 11 von nighty

hi lufti :)

ich hatte so gedacht :)

tab1
A B
aa micha
bb test
nn

tab2
A B
aa 123
bb 567
xx

tab3
A B C
aa micha 123
bb test 567
nn
xx


die zahlen vorne dacht ich sind zeilennummern,dem ist nicht so oder :)

gruss nighty



Antwort 12 von Lufti

Hallo nighty, leider ist dem nicht so, tut mir Leid. Die Mail mit der Datei ist unterwegs
Bis dann
Gruß, Lufti.

Antwort 13 von sicci

Hallo Lufti und nighty,

Hier ein weiterer Makro-Vorschlag. Weil mit Sicherheit ohne 'UsedRange' wird ein neues "Ergebnis" Blatt erzeugt. Sollten die eigentlichen Datenblätter anders aufgebaut sein ("5-7 Spalten"? im Beispiel gibt's nur je 3, bzw.4 im Ergebnisblatt) oder die Schlüsselfelder pro Blatt auch 2- oder mehr-zeilig vorkommen, müßte das Makro neu angepaßt werden.


Sub Lufti()
'Variablendefinition (Wertzuweisung in/vor For-Next/Do-Loop)
Dim intZeile%, intTab%

'Ergebnisblatt hinzufügen
   Sheets.Add After:=Sheets(2)
   ActiveSheet.Name = "Ergebnis"

'Säuberung der Datenblätter von Leerzeilen:
For intTab = 1 To 2
With Sheets(intTab)
   For intZeile = .UsedRange.Rows.Count To 1 Step -1
      If Cells(intZeile, 1) & _
         Cells(intZeile, 2) & _
         Cells(intZeile, 3) = "" Then
         Rows(intZeile).EntireRow.Delete
      End If
   Next intZeile
End With
Next intTab

'Datenblätter auf Ergebnisblatt untereinander kopieren
Sheets(1).UsedRange.Copy
Sheets(3).Paste Destination:=Cells(1, 1)
Sheets(2).UsedRange.Copy
intZeile = Sheets(3).UsedRange.Rows.Count + 1
Sheets(3).Paste Destination:=Cells(intZeile, 1)
'numerische Werte in Spalte D schieben
   Do While intZeile <= Sheets(3).UsedRange.Rows.Count
    Cells(intZeile, 3).Insert Shift:=xlToRight
    intZeile = intZeile + 1
   Loop

'Ergebnisblatt-Daten sortieren ...:
Sheets(3).UsedRange.Sort _
      Key1:=Range("A1"), _
      Key2:=Range("B1")
   
'.. und Schlüsselfelder, je 2 Zeilen, vergleichen
'wenn gleich, Datenfelder Zeile 2 in Zeile 1 kopieren
'Zeile 2 löschen
With Sheets(3)
   For intZeile = 1 To .UsedRange.Rows.Count
      If Cells(intZeile, 1) & Cells(intZeile, 2) = _
         Cells(intZeile + 1, 1) & Cells(intZeile + 1, 2) Then
         Cells(intZeile, 4) = Cells(intZeile + 1, 4)
         Rows(intZeile + 1).EntireRow.Delete
      End If
   Next
End With
End Sub


Gruß sicci

P.S.: eingefügte Kommentare, so weiß ich aus eigener Erfahrung, blähen zwar den Text auf, sind aber nützlich fürs Lesen und eine gute Übung für übersichtliche Gliederungen.

Antwort 14 von nighty

hi alle :))

37 zeilen sind zu toppen :))

gruss nighty

Antwort 15 von sicci

hallo nighty :-)

falsch! Es sind 22 (also weniger als das search-Makro :-)
15 habe ich als kleines Präsent beigefügt, zwecks saubererererr, vielleicht gar sheetverkleinernder Abarbeitung :-))

gruss sicci

Antwort 16 von sicci

.. ach ja, nochmal 4 muß man abziehn, waren auch nicht gefordert, für die zusätzliche Spaltenverschiebung. Fügte ich bei, damit das Ergebnis übersichtlich und Autofilter-kompatibel wird. Sind wir also bei 18 :-))
Gruß sicci

Antwort 17 von nighty

hi alle :)

ich schaffe es nicht kuerzer ,und es ist schon montag:(

@sicci
1:0 fuer dich grrrr
ich hoffe du bist jetzt wieder oefters hier im sn :)
revanche folgt :)

doch die motivation war mal wieder begeisternd :)
die suchfunction war auch nicht so begeisternd,musste sie erst mal auf eis legen,dachte es sei so schneller,doch suchfunction auf mehrere kreterien geht wohl nicht,dann halt wie frueher :)

gruss nighty

Option Explicit
Sub liste_erstellen()
Dim zaehler1, zaehler2, zaehler3, zaehler4
With Worksheets(3)
.Range("A1:D65535").Clear
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
.Cells(zaehler1, 1).Value = Cells(zaehler1, 1).Value
.Cells(zaehler1, 2).Value = Cells(zaehler1, 2).Value
.Cells(zaehler1, 3).Value = Cells(zaehler1, 3).Value
Next zaehler1
zaehler2 = Sheets(3).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
For zaehler1 = 1 To zaehler2
For zaehler3 = 1 To Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
If .Cells(zaehler1, 1).Value = Sheets(2).Cells(zaehler3, 1).Value And _
.Cells(zaehler1, 2).Value = Sheets(2).Cells(zaehler3, 2).Value Then
.Cells(zaehler1, 2).Value = Sheets(2).Cells(zaehler3, 2).Value
.Cells(zaehler1, 4).Value = Sheets(2).Cells(zaehler3, 3).Value
End If
If .Cells(zaehler1, 2).Value = Sheets(2).Cells(zaehler3, 2).Value And _
.Cells(zaehler1, 1).Value <> Sheets(2).Cells(zaehler3, 1).Value Then
.Cells(zaehler2 + zaehler4, 1).Value = Sheets(2).Cells(zaehler1, 1).Value
.Cells(zaehler2 + zaehler4, 2).Value = Sheets(2).Cells(zaehler1, 2).Value
.Cells(zaehler2 + zaehler4, 4).Value = Sheets(2).Cells(zaehler1, 3).Value
zaehler4 = zaehler4 + 1
End If
Next zaehler3
Next zaehler1
End With
End Sub


Antwort 18 von nighty

hi alle :)

nochmal verkuerzt um vier zeilen:)

gruss nighty

Option Explicit
Sub liste_erstellen()
Dim zaehler1, zaehler2, zaehler3, zaehler4
With Worksheets(3)
.Range("A1:D65535").Clear
Range("A1:C" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy .Range("A1:C1")
zaehler2 = Sheets(3).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
For zaehler1 = 1 To zaehler2
For zaehler3 = 1 To Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
If .Cells(zaehler1, 1).Value = Sheets(2).Cells(zaehler3, 1).Value And _
.Cells(zaehler1, 2).Value = Sheets(2).Cells(zaehler3, 2).Value Then
.Cells(zaehler1, 2).Value = Sheets(2).Cells(zaehler3, 2).Value
.Cells(zaehler1, 4).Value = Sheets(2).Cells(zaehler3, 3).Value
End If
If .Cells(zaehler1, 2).Value = Sheets(2).Cells(zaehler3, 2).Value And _
.Cells(zaehler1, 1).Value <> Sheets(2).Cells(zaehler3, 1).Value Then
.Cells(zaehler2 + zaehler4, 1).Value = Sheets(2).Cells(zaehler1, 1).Value
.Cells(zaehler2 + zaehler4, 2).Value = Sheets(2).Cells(zaehler1, 2).Value
.Cells(zaehler2 + zaehler4, 4).Value = Sheets(2).Cells(zaehler1, 3).Value
zaehler4 = zaehler4 + 1
End If
Next zaehler3
Next zaehler1
End With
End Sub


Antwort 19 von Lufti

Hallo sicci, hallo nighty und alle Anderen,
vielen Dank für eure Unterstützung und besonderen an sicci und nighty.

@sicci
Einfach Perfekt, sauber und übersichtlich gegliedert, 100% Funktion.

@nighty
Danke für den netten Kontakt (auch per Mail). Deine Lösung werde ich morgen testen. Bin mir aber sicher, daß auch sie super funzt.

Ich werde beide Lösungen versuchen so zu überarbeiten, daß meine original Tabellen damit spielen und dann sehen welche schneller ist ;-) Ich habe keine Vorstellung wie lange der Durchlauf von 15000 Datensätze so dauern wird. Das wird spannend.

Gruß nochmal an alle und dickes Lob an sicci und nighty,
Danke und weiter so,
euer Lufti.

Antwort 20 von sicci

Hallo Lufti,

danke für das Lob :-).

Finde auch nighty's Makro sehr gelungen. Es führen halt manche Wege nach Rom. Eine kleine Anmerkung hätte ich noch dazu: wenn Du seine 'zaehler-'Variablen als Integer-Typ deklarierst, wird das Makro (je mehr Datensätze desto auffälliger) etwas schneller werden.

dim zaehler% (Prozentzeichen hinter die Variable)
oder ausgeschrieben: dim zaehler as integer.

Speziell die nicht als Typ deklarierten Variablen(sind durch VBA-Voreinstellung immer Variant-Variablen) verbrauchen mehr Zeit, bei großen Datenmengen wichtig! Die Grenze von Integer-Variablen liegt bei +32766, für größere Zähler kann man den Long-Typ nehmen - immer noch schneller als der Variant.

Ist in der VBA-Hilfe unter "Optimieren von For...Next-Schleifen" schön beschrieben.

Gruß sicci

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: