Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon maxS vom 10.07.2020, 19:04 Options

Vergleich zweier Tabellen, herausfordernd individuell

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

Antwort schreiben

Antwort 1 von Saarbauer vom 10.07.2020, 19:52 Options

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

Antwort 2 von nighty vom 10.07.2020, 20:16 Options

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

Antwort 3 von nighty vom 10.07.2020, 20:27 Options

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

Antwort 4 von nighty vom 11.07.2020, 09:58 Options

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

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Tipp einschicken

News einschicken