Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
416to420
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
416to420
416to420
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Wie packe ich es in eine Schleife??

Wie packe ich es in eine Schleife?
ralle
Hallo zusammen,
habe wieder das problem mit der Schleife. Folgendes Problem:
Habe ein Makro geschrieben zur Formatierung einer Tabelle:

Sub format()
Rows("1:4").Select
Selection.Insert Shift:=xlDown
Range("A4").Select
ActiveCell.FormulaR1C1 = "KTO"
Range("B4").Select
ActiveCell.FormulaR1C1 = "Bezeichnung"
Range("C4").Select
ActiveCell.FormulaR1C1 = "Jahr´Soll"
Range("D4").Select
ActiveCell.FormulaR1C1 = "Soll lfd. Monat"
Range("E4").Select
ActiveCell.FormulaR1C1 = "gebucht bisher"
Range("F4").Select
ActiveCell.FormulaR1C1 = "Diff. Soll-Ist"
Range("A3:A4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Range("B3:B4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Range("C3:C4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Range("D3:D4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Range("E3:E4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Range("F3:F4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Range("A3:F4").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
ActiveCell.FormulaR1C1 = "Kostenstelle:"
Range("A1").Select
Selection.Font.Bold = True
End Sub

Dieses Makro soll nun in allen Tabellenblättern nacheinander ausgeführt werden. (Ca. 30 Tabellenblätter, kann varrieren)
Für eine Hilfe wäre ich sehr dankbar
Gruß
ralle

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Der einfache Weg...
Uwe
... ohne die Funktionsweise geprüft zu haben
Sub format()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
next
End Sub
Eine weitere Möglichkeit wäre mit einem With-Block zu arbeiten, was jedoch den Punktoperator als Bezüge benötigt.
Gruß!
AW: ...Achtung: gilt nur, wenn auch ...
Uwe
für alle Arbeitstabelen in einer Arbeitsmappe dieser Formatierungseinschub erfolgen soll. Ansonsten, wenn Einzelblätter doven aisgenommen werden sollen, sin diese zuvor zu schützen.
Gruß!
AW: Wie packe ich es in eine Schleife?
Nike
Hi,
nich schoen, aber selten ;-)

Sub Macro1()
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
wks.Activate
'und hier kommt dann dann Bandwurmcode hin ;-)
Next
End Sub

Bye
Nike
Anzeige
AW: Wie packe ich es in eine Schleife?
ralle
... Danke Euch allen, hat super funktioniert !!!
Hab da noch ein Makro, dass in ein Schleife eingebunden werden soll. Das selbe Problem wie vorher (für alle Tabellenblätter. Habe es versucht mit dem folgenden Bsp.:

Sub format()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
next
End Sub

Dies hat vorher auch gut geklappt, nur bei meinem folgenden Makro funktioniert das nicht, wieso?
Nachfolgend mein Makro das in eine Schleife soll:
ub loeschen()
'
'
Dim i As Long
For i = Range("A65536").End(xlUp).Row To 1 Step -1
If IsError(Range("A" & i)) Then Rows(i).Delete
If Not IsNumeric(Range("A" & i)) Then Rows(i).Delete
If Range("A" & i).Value 800000 Then Rows(i).Delete
Next
'
End Sub
Ich hoffe Ihr könnt mir helfen !!
Gruß
ralle
Anzeige
AW: Wie packe ich es in eine Schleife?
Nike
Hi,
du stellst halt keinen wirklichen Bezu zu den Worksheets her, sondern aktivierst es jeweils nur, wenn du Objektbezogen (mit . ) arbeiten wuerdest, sollte es keine Probs geben:
ub loeschen()
Dim i As Long
Dim ws As Worksheet
For Each ws In Worksheets
with ws
For i = .Range("A65536").End(xlUp).Row To 1 Step -1
If IsError(.Range("A" & i)) Then
.Rows(i).Delete
end if
If Not IsNumeric(.Range("A" & i)) Then
.Rows(i).Delete
end if
If .Range("A" & i).Value 800000 Then
.Rows(i).Delete
end if
end with
Next
End Sub
ich hoffe ich hab keinen . vergessen ;-)
Bye
Nike
Anzeige
AW: Wie packe ich es in eine Schleife?
ralle
.... bekomme eine Fehlermeldung:
"Fehler beim Kompilieren, End with ohne with"
was hat das zu bedeuten ?
Gruß
ralle
AW: Wie packe ich es in eine Schleife?
Nike
Hi,
da fehlt wohl ein end with ;-)
Mal so versuchen:

Sub loeschen()
Dim i As Long
Dim ws As Worksheet
For Each ws In Worksheets
With ws
For i = .Range("A65536").End(xlUp).Row To 1 Step -1
If IsError(.Range("A" & i)) Then
.Rows(i).Delete
End If
If Not IsNumeric(.Range("A" & i)) Then
.Rows(i).Delete
End If
If .Range("A" & i).Value < 1000 Or .Range("A" & i).Value > 800000 Then
.Rows(i).Delete
End If
Next
End With
Next
End Sub

Bye
Nike
Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige