online 1
gast (50)

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

Skripte(PHP,ASP,Perl...)Skripte(PHP,ASP,Perl...)

Fragevon zhodiac vom 12.09.2019, 11:49 Options

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

Antwort 20 von nighty vom 12.09.2019, 18:18 Options

hi zhodiac :-))

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

http://excelwelt.de/index.html

gruss nighty

Ähnliche Themen

kann wegen makro nicht drucken - was machen?
srepsac  26.06.2007 - 118 Hits - 1 Antwort

Markos unsichtbar/sichtbar schalten
User3  17.09.2007 - 72 Hits - 1 Antwort

Makro für alle Tabellenblätter verfügbar machen
dieter1958  12.01.2008 - 108 Hits - 7 Antworten

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

Version: supportware 1.9.150 / 10.06.2022, Startzeit:Mon Jan 26 01:23:17 2026