Supportnet Computer
Planet of Tech

Supportnet / Forum / Skripte(PHP,ASP,Perl...)

Makro: Spaltenabgleich





Frage

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 1 von nighty

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

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

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

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

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

öö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

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

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

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

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

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

^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

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

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

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

hi zhodiac :-)

ersetze bitte an zwei stellen im code das OK gegen vbOK

uebersehen hab :-))

gruss nighty

Antwort 17 von zhodiac

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

hi zhodiac :-)

das makro greift ja auf den index zu,daher spielen die namen keine rolle

gruss nighty

Antwort 19 von zhodiac

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

Antwort 20 von nighty

hi zhodiac :-))

schau mal hier ,sehr effektive beispiele zum lernen und gut erklaert :-))

http://excelwelt.de/index.html

gruss nighty

Antwort 21 von zhodiac

hi nighty

danke für den link.
mir ist allerdings noch ein kleines prob an der programmierung aufgefallen.
das markro hab ich mit einem button in einem separaten excel sheet angelegt mit dem namen "vergleich". damit das marko funktioniert muss ich allerdings strikt die reihenfolge einhalten, wie ich die excel sheets öffne.
soll heissen zuerst die exceldatei 1.xls dann 2.xls und zuletzt vergleich.xls (mit dem markobutton)

wenn ich nun zuerst die datei vergleich.xls öfnne und danach erst die anderen dateien sitze ich in einer endlosschleife fest aus der ich nicht mehr rauskomme.

Antwort 22 von nighty

hi zhodiac :)

da ich auf den index der workbooks zugreife ist das verstaendlich,daher die frage nach eindeutigen dateinamen

du koenntest wenn die zu vergleichenden dateien immer 1.xls und 2.xls heissen den index gegen den namen tauschen

z.b.

Workbooks(1) ersetzen durch Workbooks("1")
Workbooks(2) ersetzen durch Workbooks("2")

oder in der vergleichstabelle im open ereignis Workbooks("1") wie Workbooks("2") oeffnen

das open ereignis waere einzufuegen bei der mappe vergleich unter

alt+f11/projektexplorer/DeineArbeitsMappe

Private Sub Workbook_Open()
Workbooks.Open Filename:="C:\Temp\1.xls"
Workbooks.Open Filename:="C:\Temp\2.xls"
End Sub

nun ist die mappe vergleich ja immer der erste index
daher die naechsten 2 folgenden die geoeffnet werden bei dem oeffnen der datei vergleich index 2 und 3

dann waere noch im makro zu ersetzen

Workbooks(1) ersetzen durch Workbooks(2)
Workbooks(2) ersetzen durch Workbooks(3)

hilft dir das weiter ?

gruss nighty

Antwort 23 von zhodiac

ja das hilft mir weiter

danke :)

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: