Supportnet / Forum / Tabellenkalkulation

Hallo liebe Helfer, ich denke schon sehr lange über das folgende für mich unlösbare und schon gar nicht effizient lösbare Problem nach. Es existieren 2 Tabellenblätter, die ich vergleichen will. Tabelle1: Spalte A: Betrag1Tab1 SpalteB: Betrag2Tab1 SpalteC: Zeichensatz1Tab1 SpalteD: Betrag3Tab1 SpalteE: Zeichensatz2Tab1 SpalteF: PrimärschlüsselTab1 Tabelle2: Spalte A: Zeichensatz3Tab2 Spalte B: Zeichensatz2Tab2 Spalte C: Betrag1Tab2 Spalte D: Betrag2Tab2 Spalte E: Zeichensatz1Tab2 Spalte F: Betrag3Tab2 Spalte G: PrimärschlüsselTab2 Der Primärschlüssel identifiziert nun jede Zeile der Tabelle eindeutig. Er ist in beiden Tabellen vorhanden und dient dazu, diese zu vergleichen. Es müssen die Zeilen wie folgt miteinander verglichen werden, in denen die Primärschlüssel in beiden Tabellen übereinstimmen. Die unten aufgeführten Zellen dieser beiden Zeilen müssen nun verglichen werden: Wenn Betrag1Tab1 <>Betrag1Tab2 ODER Betrag2Tab1<>Betrag2Tab2 ODER Betrag3Tab1<>Betrag3Tab2 ODER Zeichensatz1Tab1<>Zeichensatz1Tab2 ODER Zeichensatz2Tab1<>Zeichensatz2Tab2 Dann gib Folgendes in einer Zeile aus: Primärschlüssel1Tab1, Betrag1Tab1, Betrag1Tab2, Betrag2Tab1, Betrag2Tab2, Betrag3Tab1, Betrag3Tab2, Zeichensatz1Tab1, Zeichensatz1Tab2, Zeichensatz2Tab1, Zeichensatz2Tab2 Gib diese Zeilen in dem Tabellenblatt Tabelle3 ab Zeile 2 aus (Ich benötige die erste Zeile für die Spaltenüberschriften). Wer hat Muse, mir bei diesem Problem zu helfen? Bitte, ich weiß echt nicht weiter. Das muss doch irgend wie effizient mit VBA möglich sein. Das mittels MS-Query zu machen geht leider nicht, da ich die Datei für verschiedene Dinge verwenden möchte und ich sie deshalb als Muster anwenden möchte, d.h. sie wird kopiert von mir und woanders gespeichert und umbenannt... ICH DANKE GANZ SEHR FÜR DIE HILFE. LG max

Hallo,

ich habe deine Frage mehrmals gelesen und da du von einem Primärschlüssel sprichst, vermute ich, dass du von Acesss sprichst.

leider ist nicht ganz verständlich was du wirklich willst

Gruß

Helmut

hi max

ein beispiel

gruss nighty

nicht getestet und nicht nachgebaut

koennte aber deinen wuenschen entsprechen

Option Explicit
Sub Suchen()
Call EventsOff
Dim suche As Range
Dim zaehler As Long
Dim zeile As Long
For zaehler = 2 To Workbooks(1).Worksheets(1).Range("F" & Rows.Count).End(xlUp).Row
Set suche = Workbooks(1).Worksheets(2).Range("G2" & ":G" & Workbooks(1).Worksheets(2).Range("G" & Rows.Count).End(xlUp).Row).Find((Workbooks(1).Worksheets(1).Cells(zaehler, 6)), Lookat:=xlWhole)
If Not suche Is Nothing Then
If Workbooks(1).Worksheets(1).Cells(1, 1) <> Workbooks(1).Worksheets(2).Cells(1, 3) Or _
Workbooks(1).Worksheets(1).Cells(1, 2) <> Workbooks(1).Worksheets(2).Cells(1, 4) Or _
Workbooks(1).Worksheets(1).Cells(1, 4) <> Workbooks(1).Worksheets(2).Cells(1, 6) Or _
Workbooks(1).Worksheets(1).Cells(1, 3) <> Workbooks(1).Worksheets(1).Cells(1, 5) Or _
Workbooks(1).Worksheets(1).Cells(1, 5) <> Workbooks(1).Worksheets(1).Cells(1, 2) Then
zeile = Workbooks(1).Worksheets(3).Range("A" & Rows.Count).End(xlUp).Row + 1
Workbooks(1).Worksheets(3).Cells(zeile, 1) = Workbooks(1).Worksheets(1).Cells(suche.Row, 6)
Workbooks(1).Worksheets(3).Cells(zeile, 2) = Workbooks(1).Worksheets(1).Cells(suche.Row, 1)
Workbooks(1).Worksheets(3).Cells(zeile, 3) = Workbooks(1).Worksheets(2).Cells(suche.Row, 3)
Workbooks(1).Worksheets(3).Cells(zeile, 4) = Workbooks(1).Worksheets(1).Cells(suche.Row, 2)
Workbooks(1).Worksheets(3).Cells(zeile, 5) = Workbooks(1).Worksheets(2).Cells(suche.Row, 4)
Workbooks(1).Worksheets(3).Cells(zeile, 6) = Workbooks(1).Worksheets(1).Cells(suche.Row, 4)
Workbooks(1).Worksheets(3).Cells(zeile, 7) = Workbooks(1).Worksheets(2).Cells(suche.Row, 6)
Workbooks(1).Worksheets(3).Cells(zeile, 8) = Workbooks(1).Worksheets(2).Cells(suche.Row, 3)
Workbooks(1).Worksheets(3).Cells(zeile, 9) = Workbooks(1).Worksheets(1).Cells(suche.Row, 3)
Workbooks(1).Worksheets(3).Cells(zeile, 10) = Workbooks(1).Worksheets(2).Cells(suche.Row, 5)
Workbooks(1).Worksheets(3).Cells(zeile, 11) = Workbooks(1).Worksheets(2).Cells(suche.Row, 2)
End If
End If
Next zaehler
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

hi max

schick mir eine mustertabelle zu oder korrigiere das makro selbst

oberley@t-online.de

mit eindeutigen betreff

gruss nighty

p.s.
schon wieder fehler entdeckt,mit mustertabelle ginge es besser oder eben selbst korrigieren

hi all

schon mal korrigiert :-)

gruss nighty

Option Explicit
Sub Suchen()
Call EventsOff
Dim suche As Range
Dim zaehler As Long
Dim zeile As Long
For zaehler = 2 To Workbooks(1).Worksheets(1).Range("F" & Rows.Count).End(xlUp).Row
Set suche = Workbooks(1).Worksheets(2).Range("G2" & ":G" & Workbooks(1).Worksheets(2).Range("G" & Rows.Count).End(xlUp).Row).Find((Workbooks(1).Worksheets(1).Cells(zaehler, 6)), Lookat:=xlWhole)
If Not suche Is Nothing Then
If Workbooks(1).Worksheets(1).Cells(1, 1) <> Workbooks(1).Worksheets(2).Cells(1, 3) Or _
Workbooks(1).Worksheets(1).Cells(1, 2) <> Workbooks(1).Worksheets(2).Cells(1, 4) Or _
Workbooks(1).Worksheets(1).Cells(1, 4) <> Workbooks(1).Worksheets(2).Cells(1, 6) Or _
Workbooks(1).Worksheets(1).Cells(1, 3) <> Workbooks(1).Worksheets(1).Cells(1, 5) Or _
Workbooks(1).Worksheets(1).Cells(1, 5) <> Workbooks(1).Worksheets(1).Cells(1, 2) Then
zeile = Workbooks(1).Worksheets(3).Range("A" & Rows.Count).End(xlUp).Row + 1
Workbooks(1).Worksheets(3).Cells(zeile, 1) = Workbooks(1).Worksheets(1).Cells(zaehler, 6)
Workbooks(1).Worksheets(3).Cells(zeile, 2) = Workbooks(1).Worksheets(1).Cells(zaehler, 1)
Workbooks(1).Worksheets(3).Cells(zeile, 3) = Workbooks(1).Worksheets(2).Cells(suche.Row, 3)
Workbooks(1).Worksheets(3).Cells(zeile, 4) = Workbooks(1).Worksheets(1).Cells(zaehler, 2)
Workbooks(1).Worksheets(3).Cells(zeile, 5) = Workbooks(1).Worksheets(2).Cells(suche.Row, 4)
Workbooks(1).Worksheets(3).Cells(zeile, 6) = Workbooks(1).Worksheets(1).Cells(zaehler, 4)
Workbooks(1).Worksheets(3).Cells(zeile, 7) = Workbooks(1).Worksheets(2).Cells(suche.Row, 6)
Workbooks(1).Worksheets(3).Cells(zeile, 8) = Workbooks(1).Worksheets(2).Cells(suche.Row, 3)
Workbooks(1).Worksheets(3).Cells(zeile, 9) = Workbooks(1).Worksheets(1).Cells(zaehler, 3)
Workbooks(1).Worksheets(3).Cells(zeile, 10) = Workbooks(1).Worksheets(2).Cells(suche.Row, 5)
Workbooks(1).Worksheets(3).Cells(zeile, 11) = Workbooks(1).Worksheets(2).Cells(suche.Row, 2)
End If
End If
Next zaehler
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

• Vergleich von 2 Tabellen
• 2 Tabellen vergleichen + Übereinstimmung auswerfen
• Tabellenvergleich
• Excel=Vergleich zweier Zellen.