Supportnet / Forum / Tabellenkalkulation

Hallo, ich möchte gerne zwei Tabellen (Tabelle 1 Spalte A und Tabelle 2 Spalte A) in Excel vergleichen und wenn die einzelnen Zellen von einander abweichen, soll in Tabelle 2 die jeweils verglichene Zelle eine Zeile nach unten verschoben werden. Die Spalten sehen so aus: Tab.1 Sp.A Tab.2 Sp.A PC1 PC1 PC2 PC3 PC3 PC4 PC4 PC5 PC5 PC6 ... ... Wenn ich jetzt die Tabellen vergleichen würde, würde ja herauskommen, dass nur die erste Zeile beider Tabellen gleich wären. Jetzt soll Excel aber in der Tabelle 2 den Eintrag PC3 eine Zeile weiter nach unten schieben, damit die Zeilen dann wieder übereinstimmen. Ich hoffe mir kann jemand hier im Forum helfen, habe nämlich schon das I-Net durchsucht und nur Tabellen vergleichen gefunden. Ciao

Hi s161,

kopiere nachfolgendes Makro in ein StandardModul und weise es einer Befehlsschaltfläche zu.

Option Explicit

Sub Übereinstimmungen_finden()
Dim Letzte_Zeile_Tab1 As Long, Letzte_Zeile_Tab2 As Long, Wiederholungen As Long, _
Suchbegriff As Range
Application.ScreenUpdating = False
Letzte_Zeile_Tab1 = Sheets("Tabelle1").Range("A65536").End(xlUp).Row
For Wiederholungen = 2 To Letzte_Zeile_Tab1
With Sheets("Tabelle2").Range("A1:A" & Letzte_Zeile_Tab1)
Set Suchbegriff = .Find(What:=Sheets("Tabelle2").Cells(Wiederholungen, 1), LookIn:=xlValues)
If Suchbegriff <> Sheets("Tabelle1").Cells(Wiederholungen, 1) Then
Letzte_Zeile_Tab2 = Sheets("Tabelle2").Range("A65536").End(xlUp).Row
Sheets("Tabelle2").Range("A" & Suchbegriff.Row & ":A" & Letzte_Zeile_Tab2).Copy
Sheets("Tabelle2").Cells(Suchbegriff.Row + 1, 1).PasteSpecial Paste:=xlAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Tabelle2").Cells(Suchbegriff.Row, 1).ClearContents
End If
End With
Next
End Sub

Dieses Makro vergleicht die Werte in Blatt "Tabelle1" in Spalte A mit den Werten in Blatt "Tabelle2" Spalte A. Wenn die Werte nicht gleich sind, dann wird der Bereich ausgeschnitten und um eine Zeile nach unten verschoben wieder eingefügt.

Ich hoffe, Du hast das so gemeint. Bei Problemen oder Fragen melde Dich.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

MfG,
coros
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hi coros,
danke für die schnelle Hilfe. Es funktioniert auch einwandfrei. Daaaaaaanke. :-)
Ciao

So in der Richtung würd ich auch was benötigen, aber leider keinen Plan....

hab das problem das zb. pro zeile ein Auftrag steht, und manche doppelt oder mehrfach sind, wobei aber nur spalte eins die eben manchmal gleiche Auftragsnummer enthält, mit dem Excel Filter keine Chance...

es müsste so funktionieren das wenn zb. 4 mal die gleiche zeile/auftrag (1 spalte) vorkommt 3 davon gelöscht werden und nur ein Auftrag der vieren stehen bleibt....


Danke

Hi Utti,

für Dich sollte das nächste makro das richtige sein. kopiere es in ein StandardModul und weise es ebenfalls einer Schaltfläche zu.

Option Explicit

Sub Übereinstimmungen_finden()
Dim Letzte_Zeile As Long, Wiederholungen As Long, _
Suchbegriff As Range, Addresse As String, Mindestens_ein_Wert As Long
Application.ScreenUpdating = False
Letzte_Zeile = Range("A65536").End(xlUp).Row
For Wiederholungen = 2 To Letzte_Zeile
Mindestens_ein_Wert = 0
With Worksheets(1).Range(Cells(1, 1), Cells(Letzte_Zeile, 1))
Set Suchbegriff = .Find(What:=Cells(Wiederholungen, 1), LookIn:=xlValues)
If Not Suchbegriff Is Nothing Then
Addresse = Suchbegriff.Address
Do
Mindestens_ein_Wert = Mindestens_ein_Wert + 1
If Mindestens_ein_Wert > 1 Then
Suchbegriff.Rows.ClearContents
End If
Set Suchbegriff = .FindNext(Suchbegriff)
Loop While Not Suchbegriff Is Nothing And Suchbegriff.Address <> Addresse
End If
End With
Next
Range(Cells(2, 1), Cells(Letzte_Zeile, 1)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Das Makro prüft Spalte A nach Duplicaten. Wenn gefunden werden diese mit samt der Zeile gelöscht.

Wie Du das Makro in Deine Datei bekommst, kannst Du ja wie in Antwort 1 beschrieben nachlesen.

Viel Spaß mit dem Makro.

MfG,
coros
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

traumhaft werd ich montag in der arbeit gleich mal probieren... danke

habs probiert funktioniet soweit auch nur leider löscht es manchml nicht die ganze zeile der doppelten einträge sondern nur immer inhalt der Spalte A die ist dann nur 1x vorhanden aber das wars dann auch schon die Spalte B bleibt erhalten und nur der inhalt der zeile A wird gelöscht?

Moin Utti,

hmmm, das ist aber merkwürdig. Bei mir funktioniert das Makro, also es löscht die gesamte Zeile. Es kann natürlich unter Umständen etwas in Deiner Datei sein, dass das Makro nicht den gewünschten Erfolg hat. Na egal, nimm mal nachfolgendes Makro, dass auch bei Dir funktionieren sollte. Kopiere es wieder in ein StandardModul und weise es ebenfalls einer Schaltfläche zu.

Option Explicit

Sub Übereinstimmungen_finden()
Dim Letzte_Zeile As Long, Wiederholungen As Long
Letzte_Zeile = Range("A65536").End(xlUp).Row
Application.ScreenUpdating = False
For Wiederholungen = Letzte_Zeile To 1 Step -1
If WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(Wiederholungen, 1)), _
Cells(Wiederholungen, 1)) > 1 Then
Cells(Wiederholungen, 1).EntireRow.Delete
End If
Next
End Sub

Das obige Makro sollte nun auch bei Dir funktionieren. Wenn nicht, dann melde Dich wieder.

MfG,
coros
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Coros,

Das ist eigentlich genau was ich gebrauchen könnte. Bei mir ist es aber nur eine Tabelle (Tabelle1), und die Spalten sind B und H die miteinander vergliechen werden.

Ich importiere mir 2 dif Dateien. Die eine Datei in den Spalte A-D und die andere Datei in die Spalte G-J.
Da ich in VBA nicht so bewandert bin, weiß ich nicht wie ich deinen Code abänder müßte.

Option Explicit

Sub Übereinstimmungen_finden()
Dim Letzte_Zeile_Tab1 As Long, Letzte_Zeile_Tab2 As Long, Wiederholungen As Long, _
Suchbegriff As Range
Application.ScreenUpdating = False
Letzte_Zeile_Tab1 = Sheets("Tabelle1").Range("A65536").End(xlUp).Row
For Wiederholungen = 2 To Letzte_Zeile_Tab1
With Sheets("Tabelle2").Range("A1:A" & Letzte_Zeile_Tab1)
Set Suchbegriff = .Find(What:=Sheets("Tabelle2").Cells(Wiederholungen, 1), LookIn:=xlValues)
If Suchbegriff <> Sheets("Tabelle1").Cells(Wiederholungen, 1) Then
Letzte_Zeile_Tab2 = Sheets("Tabelle2").Range("A65536").End(xlUp).Row
Sheets("Tabelle2").Range("A" & Suchbegriff.Row & ":A" & Letzte_Zeile_Tab2).Copy
Sheets("Tabelle2").Cells(Suchbegriff.Row + 1, 1).PasteSpecial Paste:=xlAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Tabelle2").Cells(Suchbegriff.Row, 1).ClearContents
End If
End With
Next
End Sub

Ich sage schon mal vielen Dank im vorraus.

Mfg Tom

Hallo an alle,

Gibt es vielleicht jemand anderes von Euch der mir helfen könnte.

Ich weiß wirklich nicht wie ich diesen Code umschreiben muß,
damit er für meine Varriante funktioniert.

Ich bin zur Zeit auf Montage und habe nicht viele Möglichkeiten,
als bei Euch Profis mal nach zu fragen.
Habe hier ein Excel-Sheet zur Verfügung bekommen,
womit ich Dif-Dateien vergleichen kann.
Der Vergleich funktioniert einwandfrei. Aber ich muß vorher,
damit ich sie vergleichen kann manuell anpassen.
Eine heiden Arbeit bei ein paar Tausend Zeilen.

Ich würde mich freuen wenn mir einer von Euch helfen könnte.
Besten Dank im vorraus.

Mfg Tom

• Tabellen vergleichen
• Tabellen vergleichen
• 2 Excel Tabellen vergleichen und identische Zellen farbig hinterlegen
• 2 Excel-Tabellen vergleichen und neue Tabelle erstellen
• 2 spalten aus 2 Exceltabellen vergleichen