Makro: Spaltenabgleich
hallo,
ich habe folgende (für mich) unlösbare aufgabe bekommen:
1x im monat werden aus sap spezielle daten in ein excel sheet exportiert. um sicherzugehen dass diese daten immer aus den gleichen "spaltenbezeichnungen" besteht soll ich nun ein makro erstellen, welches die aktuell gezogenene excel datei mit der aus dem vormonat vergleicht. wichtig bei dem vergleich sind nicht die daten in den zeilen, sondern lediglich nur die spaltenbezeichnungen wie z.b. name, iststunden, sollstunden etc.
im besten fall sollen änderungen noch farblich gekennzeichnet werden, wenn z.b. eine spalte im vergleich zum vormanat fehtl
ich hab nichtmal den kleinsten ansatz
vielen dank im voraus für die hilfe
Antwort schreiben
Antwort 1 von nighty vom 12.09.2019, 12:31 Options
hi zhodiac :-)
ein ansatz,wobei beide dateien geoeffnet sein sollten und keine weiteren offen sein duerfen,liesse sich mit eindeutiger dateinamensgebung anders gestalten
gruss nighty
Option Explicit
Sub vergleich()
Dim w1x As Integer, w2x As Integer, w3x As Integer, zaehler1 As Integer
w1x = Workbooks(1).Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
w2x = Workbooks(2).Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
If w1x > w2x Then
w3x = w1x
Else
w3x = w2x
End If
For zaehler1 = 1 To w3x
If Workbooks(1).Sheets(1).Cells(1, zaehler1) <> Workbooks(2).Sheets(1).Cells(1, zaehler1) Then
Workbooks(1).Sheets(1).Cells(1, zaehler1).Interior.ColorIndex = 6
Workbooks(2).Sheets(1).Cells(1, zaehler1).Interior.ColorIndex = 6
End If
Next zaehler1
End Sub
Antwort 2 von nighty vom 12.09.2019, 12:44 Options
hi all :-)
bei fehlenden spalten stimmen ja die positionen nicht mehr ueberein daher noch eine kettenreaktion in gang gesetzt wird,liesse sich mit der findfunction realisieren bzw mit einer 2 schleife.
gruss nighty
Antwort 3 von zhodiac vom 12.09.2019, 13:25 Options
hi nighty,
danke für deine rasche antwort. ich bin im bereich noch voller newby deswegen verstehe ich nur bahnhof :)
sorry
Antwort 4 von zhodiac vom 12.09.2019, 13:29 Options
teilweise verstehe ich den code, teilweise auch nich (was ja auch nicht immer sein muss :D )
die findfunction bzw. schleife ist für mich neu, deswegen steh ich da auf dem schlauch
Antwort 5 von nighty vom 12.09.2019, 13:35 Options
hi zhodiac :-)
sollen die zellen die eventuell durch eine fehlende spalte verschoben sind aber dennoch identisch vom inhalt sind markiert werden ?
gruss nighty
Antwort 6 von zhodiac vom 12.09.2019, 13:38 Options
ööhhhhmmmm................ja.
außer es ist möglich eine messagebox auszugeben, die z.b. sagt:
"es fehlt die Spalte "IstStunden", "SollStunden" etc
das wäre dann die deluxe ausführung wo ich evtl. meine cheffin glücklich machen könnte ;)
Antwort 7 von zhodiac vom 12.09.2019, 13:49 Options
konkretes beispiel:
A1 A2 A3 A4
1 Projekt Nummer Name Stunden
2 Suchen 134 Mayer 46
3 Risiko 234 Kunz 44
es soll nun geprüt werden ob in den spalten a1-a4 in der zeile 1 die bezeichnungen projekt, nummer, name und stunden identisch exportiert wurden.
die daten in den zeilen 2 und 3 sind erstmal egal, da diese nicht indentisch sein können, speziell bei den stunden, da diese sich von monat zu monat ändern
Antwort 8 von nighty vom 12.09.2019, 14:10 Options
hi zhodiac :-)
probier das mal .-))
gruss nighty
Sub vergleich()
Dim w1x As Integer, w2x As Integer, w3x As Integer, zaehler1 As Integer
Dim suche As Range
Dim Nachricht As Variant
w1x = Workbooks(1).Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
w2x = Workbooks(2).Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
If w1x > w2x Then
w3x = w1x
Else
w3x = w2x
End If
For zaehler1 = 1 To w3x
Set suche = Workbooks(2).Sheets(1).Range(Workbooks(2).Sheets(1).Cells(1, 1), Workbooks(2).Sheets(1).Cells(1, w3x)).Find(Workbooks(1).Sheets(1).Cells(1, zaehler1), Lookat:=xlWhole)
If suche Is Nothing Then
Nachricht = MsgBox("Die Spalte " & Workbooks(1).Sheets(1).Cells(1, zaehler1) & " ist nicht vorhanden in Mappe2" & OK)
End If
If Workbooks(1).Sheets(1).Cells(1, zaehler1) <> Workbooks(2).Sheets(1).Cells(1, zaehler1) Then
Workbooks(1).Sheets(1).Cells(1, zaehler1).Interior.ColorIndex = 6
Workbooks(2).Sheets(1).Cells(1, zaehler1).Interior.ColorIndex = 6
End If
Next zaehler1
End Sub
Antwort 9 von zhodiac vom 12.09.2019, 14:16 Options
subbi, danke dir
ich nehme an dass bei "Workbooks(1).Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column" das sich (1) auf den speziellen dateinamen, bzw. blattname usw. bezieht?
Antwort 10 von zhodiac vom 12.09.2019, 14:25 Options
ich bekomm hier ne fehlermeldung:
Set suche = Workbooks(2).Sheets(1).Range(Workbooks(2).Sheets(1).Cells(1, 1), Workbooks(1).Sheets(1).Cells(1, w3x)).Find(Workbooks(1).Sheets(1).Cells(1, zaehler1), Lookat:=xlWhole)
Antwort 11 von nighty vom 12.09.2019, 14:34 Options
hi zhodiac :-)
getestet mit excel 2000,excel 2007 duerfte ausgeschlossen sein,eventuelle geschuetzte bereiche oder verbundene zellen ?
wenn alle stricke reissen koennte ich statt der findfunction die langsamere variante der 2 schleife einsetzen
gruss nighty
Antwort 12 von zhodiac vom 12.09.2019, 14:40 Options
^boah geilo! hattest recht. hab alle zeilen und spalten eingeblendet und dann gings.
was müsste ich noch einbinden damit ne msgbox kommt: alle spalten identisch
sonst könnte man denken das marko macht nix wenn alles passt :D
Antwort 13 von nighty vom 12.09.2019, 15:03 Options
hi zhodiac :-)
probier das mal :-))
gruss nighty
Sub vergleich()
Dim w1x As Integer, w2x As Integer, w3x As Integer, zaehler1 As Integer
Dim suche As Range
Dim schalter As Boolean
Dim Nachricht As Variant
w1x = Workbooks(1).Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
w2x = Workbooks(2).Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
If w1x > w2x Then
w3x = w1x
Else
w3x = w2x
End If
For zaehler1 = 1 To w3x
Set suche = Workbooks(2).Sheets(1).Range(Workbooks(2).Sheets(1).Cells(1, 1), Workbooks(2).Sheets(1).Cells(1, w3x)).Find(Workbooks(1).Sheets(1).Cells(1, zaehler1), Lookat:=xlWhole)
If suche Is Nothing Then
Nachricht = MsgBox("Die Spalte " & Workbooks(1).Sheets(1).Cells(1, zaehler1) & " ist nicht vorhanden in Mappe2" & OK)
schalter = True
End If
If Workbooks(1).Sheets(1).Cells(1, zaehler1) <> Workbooks(2).Sheets(1).Cells(1, zaehler1) Then
Workbooks(1).Sheets(1).Cells(1, zaehler1).Interior.ColorIndex = 6
Workbooks(2).Sheets(1).Cells(1, zaehler1).Interior.ColorIndex = 6
schalter = True
End If
Next zaehler1
If schalter = False Then Nachricht = MsgBox("SpaltenUeberschriften sind bei beiden Mappen identisch" & OK)
End Sub
Antwort 14 von zhodiac vom 12.09.2019, 15:11 Options
you are my hero!!!!
sehr geil. will sowas auch mal können :(
btw: gibt es grundsätzlich eine möglichkeit die markos so zu gestalten, dass die dateien nicht immer gleich heissen müssen? sozusagen ne automatische anpassung des markos wenn sich der dateiname ändert.
denke das ist aber nicht möglich, oder?
Antwort 15 von nighty vom 12.09.2019, 15:29 Options
hi zhodiac :-)
es gibt die moeglichkeit der index wie der namen anweisung
index angabe
Workbooks(1) = erste geoeffnete mappe
Workbooks(2) = zweite geoeffnete mappe
usw.
das ende des jeweiligen indexes liesse sich mit
Dim AnzahlMappen As Integer
AnzahlMappen = Workbooks.Count
ermitteln
NamensAngabe
Workbooks("Mappe1")
Workbooks("Mappe2")
oder noch
ThisWorkbook
was sich auf die datei bezieht von wo aus das makro gestartet worden ist
genauso zu verfahren bei den sheets bzw tabellen
bei einer auslesung von einer unbestimmten anzahl von dateien aus einer directory ueber die file search methode liesse sich der namen mit DIR auslesen
gruss nighty
Antwort 16 von nighty vom 12.09.2019, 15:37 Options
hi zhodiac :-)
ersetze bitte an zwei stellen im code das OK gegen vbOK
uebersehen hab :-))
gruss nighty
Antwort 17 von zhodiac vom 12.09.2019, 15:40 Options
ist mir alles zu kompliziert.
müssen sie eben drauf achten dass die beiden dateinen immer gleich heissen :)
ich danke dir vielmals für deine hilfe. sitze da nun schon seit 2 tagen dran und wäre es wohl noch eine weile
Antwort 18 von nighty vom 12.09.2019, 15:48 Options
hi zhodiac :-)
das makro greift ja auf den index zu,daher spielen die namen keine rolle
gruss nighty
Antwort 19 von zhodiac vom 12.09.2019, 16:15 Options
kennst du evtl. ne internetseite wo ich newbys bischen einlesen können? ich hab hier zwar nen 400 seiten wälzer liegen, aber für nen neuling nicht gerade das beste für den einstieg