Makro auf jeder Seite durchführen

Forumthread: Makro auf jeder Seite durchführen

23.10.2006 18:32:50

Jürgen

Hallo zusammen,
man lernt ja dazu und dann möchte noch mehr lernen. Mit Unterstützung aus dem Forum habe ich eine Schleife gebastelt, die in Abhängigkeit eines Suchkriteriums in B1 und einer über eine Inputbox eingegebene Zeilen-Nr. Sverweise schreibt. D.h. daß ich je Blatt einmal einen Button drücke und die Formeln dann eingetragen werden. Nun habe ich aber mehrere Blätter in einer Datei, die alle gleich aufgebaut sind, nur das Suchkriterium ist ein anderes.
Nun wäre ich glücklich, wenn mir jemand sagen könnte, wie ich das nachfolgende Skript ergänzen muß um nur einmal eine ZeilenNr. eingeben zu müssen und das Makro dann von Blatt zu Blatt springt und sich jeweils das Suchkriterium für das jeweilige Blatt dazu zieht.
Hier das Listing:


Sub Kostenverdichtung_Budget()
' Mit dem Makro sollen Sverweise erstellt werden, _
der sich zusammensetzen soll _
aus einem konstanten Pfad (Pfad) _
einem Dateinamen, der aus Spalte A (Zeilennummer über i) ausgelesen wird _
einem konstanten Blattnamen (Blatt) und einem Suchkriterium aus _
Zelle B1 zusammensetzt
Dim KoSt    ' Dateiname aus Spalte A
Dim i       ' Nr. der Zeile, die aktualisiert werden soll aus Spalte A
Dim Rückfr  ' Inputbox zur Eingabe der ZeilenNr. i
Dim Pfad    ' Pfad mit den Quelldaten
Dim Blatt   ' Blattname (immer gleich)
Dim c       ' Zielspalte
Dim wsCount ' Anzahl Arbeitsblätter
On Error GoTo Errorhandler
wsCount = ActiveWorkbook.Worksheets.Count
'Pfad in dem die Quelldatei liegt
Pfad = "'O:\200CC [...]\Budget 2007\04 Sammelordner\03 Übersicht_Bud\"
Blatt = "Übersicht_Budget_07"
Rückfr = InputBox("Welche Zeile soll aktualisiert werden", "Zeilennummer eingeben")
' For Each Worksheet 1 to wsCount
i = Rückfr
KoSt = Range("A" & i).Value
'Prüfung, ob in Spalte A ein Dateiname steht (KoSt <> "leer)
If KoSt = "" Then
MsgBox ("In Zelle A" & i & " ist kein Dateiname eingetragen." & Chr(10) & _
"Bitte Eingabe überprüfen und erneut probieren!"), vbCritical
Exit Sub
End If
c = 4   ' D
' Eintragen der Formeln
' Spalte D
Cells(i, c).FormulaR1C1 = "=VLOOKUP(R1C2," & Pfad & "[" & KoSt & "]" & Blatt & "'!R3C1:R300C6,3,FALSE)"
' Spalte E
Cells(i, c + 1).FormulaR1C1 = "=VLOOKUP(R1C2," & Pfad & "[" & KoSt & "]" & Blatt & "'!R3C1:R300C6,4,FALSE)"
' Spalte F
Cells(i, c + 2).FormulaR1C1 = "=VLOOKUP(R1C2," & Pfad & "[" & KoSt & "]" & Blatt & "'!R3C1:R300C6,5,FALSE)"
' Spalte G
Cells(i, c + 3).FormulaR1C1 = "=VLOOKUP(R1C2," & Pfad & "[" & KoSt & "]" & Blatt & "'!R3C1:R300C6,6,FALSE)"
' Spalte K Datum der Durchführung
Cells(i, c + 7).Value = Date
' Spalte L Uhrzeit der Durchführung
Cells(i, c + 8).Value = Time
Cells(i, c + 8).NumberFormat = "h:mm"
Exit Sub
Errorhandler:
MsgBox ("Die Prozedur wurde aufgrund eines Fehlers abgebrochen." & Chr(10) & _
"Wahrscheinlich existiert die Datei:  " & KoSt & "  nicht " & Chr(10) & _
"oder der Dateiname wurde nicht richtig in Zelle A" & i & " eingetragen!"), vbCritical, "Prüfen und wiederholen!"
Exit Sub
End Sub

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro auf jeder Seite durchführen

23.10.2006 18:57:38

Daniel
AW: Makro auf jeder Seite durchführen

24.10.2006 11:07:42

Jürgen

AW: Makro auf jeder Seite durchführen

23.10.2006 18:57:38

Daniel

Hallo
so must du deinen Code Eränzen (Ergänzungen sind mit XXX gekennzeichnet)


Publich Sub Kostenverdichtung_Budget()
' Mit dem Makro sollen Sverweise erstellt werden, _
der sich zusammensetzen soll _
aus einem konstanten Pfad (Pfad) _
einem Dateinamen, der aus Spalte A (Zeilennummer über i) ausgelesen wird _
einem konstanten Blattnamen (Blatt) und einem Suchkriterium aus _
Zelle B1 zusammensetzt
Dim KoSt    ' Dateiname aus Spalte A
Dim i       ' Nr. der Zeile, die aktualisiert werden soll aus Spalte A
Dim Rückfr  ' Inputbox zur Eingabe der ZeilenNr. i
Dim Pfad    ' Pfad mit den Quelldaten
Dim Blatt   ' Blattname (immer gleich)
Dim c       ' Zielspalte
Dim wsCount ' Anzahl Arbeitsblätter
xxx Dim WS As worksheet
On Error GoTo Errorhandler
wsCount = ActiveWorkbook.Worksheets.Count
'Pfad in dem die Quelldatei liegt
Pfad = "'O:\200CC [...]\Budget 2007\04 Sammelordner\03 Übersicht_Bud\"
Blatt = "Übersicht_Budget_07"
Rückfr = InputBox("Welche Zeile soll aktualisiert werden", "Zeilennummer eingeben")
xxx For Each WS in this workbook.sheets.count
xxx   WS.select
Hier folgt jetzt der restliche Code von dir.
xxx Next
Exit Sub
Errorhandler:
MsgBox ("Die Prozedur wurde aufgrund eines Fehlers abgebrochen." & Chr(10) & _
"Wahrscheinlich existiert die Datei:  " & KoSt & "  nicht " & Chr(10) & _
"oder der Dateiname wurde nicht richtig in Zelle A" & i & " eingetragen!"), vbCritical, "Prüfen und wiederholen!"
Exit Sub
End Sub

die So berschriebne Variante ist noch nicht so ganz optimal, da der Wechsel des Blattes auch auf dem Bildschirm angezeit wird. Aber das ist zum Ausprobieren vielleicht auch ganzi gut so.
Wenn du das elemnieren willst, kannst du das WS.SELECT auch weglassen, dann musst du aber vor JEDES "RANGE()" oder "CELLS()" ein "WS." setzen, damit sichergestellt ist, daß auch immer das gerade aktuelle Sheet angesprochen wird.
WS.Cells(...).FormulaR1C1 = "..."
noch eleganter wäre die With-Klammer
das sieht dann so aus,


for each WS in acitveworkbook.sheets
with WS
hier der Makro-Text
end with
next

allerdings muß dann vor jedes Range- und Cells- Objekt ein "." geschrieben werden.
Damit weis der Interpreter im Pogrammablauf, daß das unter WITH definierte Objekt gemeint ist.
Zusätzlich würde ich noch empfehlen, die Variablen nicht nur zu benennen, sondern auch den Variablentyp zuzuweisen.
Sonst sind alle Variablen vom Typ Variant, was Speicherplatz kostet und langsam ist.
Gruß Daniel

AW: Makro auf jeder Seite durchführen

24.10.2006 11:07:42

Jürgen

Hat geklappt, vielen Dank Daniel.
Einen kleine Bug hattest Du noch drin; in der einen Zeile war das Count am Ende zuviel
xxx For Each WS in this workbook.sheets.count
Gruß
Jürgen

Beliebteste Forumthreads (12 Monate)

Makro auf jeder Seite durchführen

Forumthread: Makro auf jeder Seite durchführen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread