Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
812to816
812to816
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro auf jeder Seite durchführen

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

247 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige