Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1480to1484
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
Inhaltsverzeichnis

Tabellenvergleich aktualiserter Stände mit Farb

Tabellenvergleich aktualiserter Stände mit Farb
20.03.2016 18:26:48
Marco
Hallo zusammen,
zur Zeit stelle ich mich der Aufgabe ein Makro für einen Vergleich einer Reporting zu erstellen.
Neben dem makrorekorder habe ich mir schon ein paar Kenntnisse angeeignet, diese reichen hierfür jedoch definitiv nicht und ich bitte euch um eure Unterstützung.
Ausgangssituation:
Fertig erstellte Tabelle aus Rohdaten:
Spalte a : ID (einmalig)
Spalte b : Name
Spalte c-(noch nicht genau klar): Infos zu Daten (Schreibweise: 01/2016 (KW))
Diese Rohdatenbank wird dauerhaft gefüttert mit neuen Daten.
Mein Problem:
Die Datei wurde zum Zeitpunkt 1 erstellt, in der darauffolgenden Woche soll nun aus den gleichen Rohdaten die gleich aufgebaute Datei erstellt werden mit farblicher Markierung was sich geändert hat und was komplett neu ist.
Wenn also in Spalte D Zeile2 (ID 1) zum Zeitpunkt 1 01/2016 Stand und durch die neuen Daten jetzt die Informationen zur ID 1 in Zeile 3 stehen und in D 02/2016 steht, soll dies farblich Orange hinterlegt werden.
Ich bin also auf der Suche nach einer Vergleichsfunktion die:
1. Nach erstellen der erneuerten Datei (Datei2) die vorherige Datei (Datei1) öffnet
2. Anhand des feststehenden Merkmales (ID in Spalte A) die gesamte Zeile aus Datei2 mit den Informationen für die ID in Datei1 vergleicht (Die Zeilen können je nach Datei unterschiedlich sein durch neue Informationen in der Tabelle)
3. Die unterschiedlichen Informationen je ID in Datei 2 orange färben
4. Komplette Zeilen mit neuen ID's (vorhanden in Datei2 aber nicht Datei1) ebenfalls orange färben.
Ich würde mich unendlich auf Ihre und eure Unterstützung freuen.
Vielen Dank und freundliche Grüße
Marco

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellenvergleich aktualiserter Stände mit Farb
21.03.2016 10:00:12
ChrisL
Hi Marco

Sub t()
Dim WB1 As Workbook, WB2 As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, iiZeile As Long
Dim iSpalte As Integer
Application.ScreenUpdating = False
Set WB1 = Workbooks.Open(ThisWorkbook.Path & "\Mappe1.xlsx")
Set WB2 = ThisWorkbook
Set WS1 = WB1.Worksheets("Tabelle1")
Set WS2 = WB2.Worksheets("Tabelle1")
WS2.Cells.Interior.Pattern = xlNone
For iZeile = 1 To WS2.Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(WS1.Columns(1), WS2.Cells(iZeile, 1)) = 0 Then
Call ZeileFaerben(WS2, iZeile)
Else
iiZeile = Application.Match(WS2.Cells(iZeile, 1), WS1.Columns(1), 0)
For iSpalte = 2 To WS1.Range("IV1").End(xlToLeft).Column
If WS2.Cells(iZeile, iSpalte)  WS1.Cells(iiZeile, iSpalte) Then
Call ZeileFaerben(WS2, iZeile)
Exit For
End If
Next iSpalte
End If
Next iZeile
WB1.Close False
End Sub
Private Sub ZeileFaerben(WS As Worksheet, Zeile As Long)
With WS.Rows(Zeile).Interior
.Pattern = xlSolid
.Color = 49407
End With
End Sub
cu
Chris

Anzeige
Tabellenvergleich aktualisierter Stände
21.03.2016 12:24:02
Marco
Hallo Chris,
vielen Dank für deine Unterstützung!
Sobald ich das Makro ausführe markiert es mir nun die Gesamte Zeile für Änderungen in der Spalte A-E, die ebenfalls benötigten Spalten F-Y werden ignoriert.
Ebenfalls wird bei Änderungen die gesamte Zeile orange gefärbt, es sollte wenn möglich nur die geänderte Zelle sein.
Bei neuen Zeilen funktioniert es einwandfrei.
Ich würde mich sehr über deine erneute Hilfe freuen.
Vielen Dank und mit freundlichen Grüßen
Marco

AW: Tabellenvergleich aktualisierter Stände
21.03.2016 12:32:51
ChrisL
Hi Marco
Lade bitte mal ein Beispiel hoch. Kannst beide Tabellen in die gleiche Datei machen.
cu
Chris

Anzeige
AW: Tabellenvergleich aktualisierter Stände
21.03.2016 13:08:12
Marco
Hi Chris,
habe nun eine Datei angehängt mit Musterdaten.
https://www.herber.de/bbs/user/104497.xlsx
Mir ist ebenfalls aufgefallen, dass die gesamte Kopfzeile ebenfalls als geändert markiert wurde.
Es wäre perfekt wenn erst ab Zeile 8 geprüft wird und dann eben wie gehabt von Spalte A bis Y.
Und jeweils nur die Neuen Zeilen (neue ID's) komplett von A-Y farblich Orange und Änderungen bei bestehenden nur die Zelle Orange.
Vielen Dank für die Mühe
Mit freundlichen Grüßen
Marco

AW: Tabellenvergleich aktualisierter Stände
21.03.2016 13:37:57
ChrisL
Hi Marco
So...
Sub t()
Dim WB1 As Workbook, WB2 As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, iiZeile As Long
Dim iSpalte As Integer
Application.ScreenUpdating = False
Set WB1 = Workbooks.Open(ThisWorkbook.Path & "\Mappe1.xlsx")
Set WB2 = ThisWorkbook
Set WS1 = WB1.Worksheets("Stand alt")
Set WS2 = WB2.Worksheets("Stand neu")
WS2.Cells.Interior.Pattern = xlNone
For iZeile = 8 To WS2.Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(WS1.Columns(1), WS2.Cells(iZeile, 1)) = 0 Then
With WS2.Range(WS2.Cells(iZeile, 1), WS2.Cells(iZeile, 25)).Interior
.Pattern = xlSolid
.Color = 49407
End With
Else
iiZeile = Application.Match(WS2.Cells(iZeile, 1), WS1.Columns(1), 0)
For iSpalte = 2 To WS1.Range("IV7").End(xlToLeft).Column
If WS2.Cells(iZeile, iSpalte)  WS1.Cells(iiZeile, iSpalte) Then
With WS2.Cells(iZeile, iSpalte).Interior
.Pattern = xlSolid
.Color = 49407
End With
End If
Next iSpalte
End If
Next iZeile
WB1.Close False
End Sub

cu
Chris

Anzeige
AW: Tabellenvergleich aktualisierter Stände
21.03.2016 17:33:41
Marco
Unendlichen Dank!!
Es funktioniert einwandfrei!!!!
Ich bin jetzt im weiteren arbeiten noch über ein Hindernis gestolpert.
Das 1. Workbook soll die neuste Datei aus dem Archiv sein.
Für das Öffnen der Datei habe ich einen Weg gefunden.
__
Sub JuengsteDatei()
Const strVerz As String = "P:\Projekte\Reporting\Test_Reporting\Archiv\"
Const strExt As String = ".xlsx"
Dim strDatei As String, strScratch As String
strScratch = Dir(strVerz & "*" & strExt)
strDatei = strScratch
Do While strScratch  ""
If FileDateTime(strVerz & strDatei)  "" Then
Workbooks.Open strVerz & strDatei
Else
MsgBox "keine Datei gefunden"
End If
Call t
End Sub

Sub t()
Dim WB1 As Workbook, WB2 As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, iiZeile As Long
Dim iSpalte As Integer
Application.ScreenUpdating = False
Set WB1 = Workbooks(?)                 WS1.Cells(iiZeile, iSpalte) Then
With WS2.Cells(iZeile, iSpalte).Interior
.Pattern = xlSolid
.Color = 49407
End With
End If
Next iSpalte
End If
Next iZeile
WB1.Close False
End Sub

Vielen Dank für Ihre Mühe bisher!!!
Mit freundlichen Grüßen in den Abend
Marco

Anzeige
AW: Tabellenvergleich aktualisierter Stände
22.03.2016 08:22:33
ChrisL
Hi Marco
Private Function JuengsteDatei() As Workbook
Const strVerz As String = "P:\Projekte\Reporting\Test_Reporting\Archiv\"
Const strExt As String = ".xlsx"
Dim strDatei As String, strScratch As String
strScratch = Dir(strVerz & "*" & strExt)
strDatei = strScratch
Do While strScratch  ""
If FileDateTime(strVerz & strDatei)  "" Then
Set JuengsteDatei = Workbooks.Open(strVerz & strDatei)
Else
MsgBox "keine Datei gefunden"
End If
End Function


Sub t()
Dim WB1 As Workbook, WB2 As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, iiZeile As Long
Dim iSpalte As Integer
Application.ScreenUpdating = False
If JuengsteDatei Is Nothing Then Exit Sub
Set WB1 = JuengsteDatei
Set WB2 = ThisWorkbook
Set WS1 = WB1.Worksheets("Data")
Set WS2 = WB2.Worksheets("Data")
WS2.Cells.Interior.Pattern = xlNone
For iZeile = 8 To WS2.Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(WS1.Columns(1), WS2.Cells(iZeile, 1)) = 0 Then
With WS2.Range(WS2.Cells(iZeile, 1), WS2.Cells(iZeile, 25)).Interior
.Pattern = xlSolid
.Color = 49407
End With
Else
iiZeile = Application.Match(WS2.Cells(iZeile, 1), WS1.Columns(1), 0)
For iSpalte = 2 To WS1.Range("IV7").End(xlToLeft).Column
If WS2.Cells(iZeile, iSpalte)  WS1.Cells(iiZeile, iSpalte) Then
With WS2.Cells(iZeile, iSpalte).Interior
.Pattern = xlSolid
.Color = 49407
End With
End If
Next iSpalte
End If
Next iZeile
WB1.Close False
End Sub

cu
Chris

Anzeige
Tabellenvergleich aktualisierter Stände
22.03.2016 10:38:38
Marco
Hi Chris,
wenn ich den Code benutze springt er hier immer wieder nach oben:
If JuengsteDatei Is Nothing Then Exit Sub
Set WB1 = JuengsteDatei
Set WB2 = ThisWorkbook
Ich habe die zwei Codes getrennt, doch dann findet er im 2. Teil keinen Bezug mehr für:
Set WB1 = JuengsteDatei
Hast du mir hier noch einen Tipp wie ich dieses Problem umgehe?
Vielen Dank :)

AW: Tabellenvergleich aktualisierter Stände
22.03.2016 11:53:49
ChrisL
Hi Marco
Beide Codes bleiben separat, müssen aber ins gleiche Modul. Der erste Teil habe ich von einer Prozedur (Sub) in eine Funktion (Function) umgeschrieben. Funktionen geben einen Wert (das Workbook) zurück, was bei Prozeduren nicht der Fall ist.
cu
Chris

Anzeige
AW: Tabellenvergleich aktualisierter Stände
22.03.2016 13:14:11
Marco
Hi Chris,
ok ich habe beide Codes in einem Modul.
Jedoch wenn ich das Modul starte, läuft zu erst die Funktion an.
Im Loop so oft, bis die aktuellste Datei im Verzeichnis ausgemacht wurde und geöffnet wurde, so weit verstehe ich jetzt auch alles.
Wenn wir jedoch dann zu End Function kommen, beginnt die Funktion immer wieder aufs neue.
Wenn ich Call t für den zweiten Code hinter dem Öffnen der Datei in der Funktion setze wird mit der Prozedur gestartet.
Beim Befehl
If JuengsteDatei Is Nothing Then Exit Sub
kommt er jedoch immer wieder zur Funktion.
Ich habe diesen Befehl auch schon geklammert dann passiert jedoch das gleiche bei:
Set WB1 = JuengsteDatei.
Er springt wieder hoch zur Funktion.
Ich habe das Gefühl, dass nicht erkannt wird, dass die jüngsteDatei schon geöffnet wurde.
Ich habe nur noch als Idee, dass man die Funktion als Sub macht, anstelle des öffnens den DateiName mit Pfad in die Zelle A1 schreibt und im zweiten Sub dann mit set wb1 = das Workbook mit Name aus A1 öffnet.
Das wäre nur eine Idee.
Bitte um Hilfe
Gruß Marco

Anzeige
AW: Tabellenvergleich aktualisierter Stände
22.03.2016 13:27:08
ChrisL
Hi Marco
Den Code genau wie er ist Copy/Paste in ein Modul und wie bisher die Prozedur t() starten. Ich hab es getestet, bei mir liefs. Braucht auch kein Call t und gar nichts.
t = Prozedur
JuengsteDatei = Funktion
Prozeduren/Makros werden ausgeführt/abgespielt, Funktionen stehen einfach so da und lassen sich ohne Prozedur nicht verwenden oder ausführen.
Zufälligerweise steht die Funktion aktuell oben, könnte aber genau so gut unten stehen.
cu
Chris

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige