Schleifen sind zentraler Bestandteil jeder Programmiersprache. Anhand von Schleifen ist es möglich, Programmanweisungen mehrmals hintereinander zu wiederholen. Beispiel einer Programmierung ohne Schleifeneinsatz:
Cells(1, 1).Value = "ZEILE 1"
Cells(2, 1).Value = "ZEILE 2"
Cells(3, 1).Value = "ZEILE 3"
Cells(4, 1).Value = "ZEILE 4"
Cells(5, 1).Value = "ZEILE 5"
Cells(6, 1).Value = "ZEILE 6"
Beispiel der gleichen Programmierung mit Schleifeneinsatz:
For iCounter = 1 To 6
Cells(iCounter, 1).Value = "Zeile " & iCounter
Next iCounter
Jeder Schleifentyp kann weitere Bedingungsprüfungen enthalten. Bei Zählschleifen kann die Schrittgröße festgelegt werden; der Default-Wert ist 1.
Sub ForNextCounter()
Dim dValue As Double
Dim iCounter As Integer
For iCounter = 1 To 100
dValue = dValue + iCounter * 1.2
Next iCounter
MsgBox "Ergebnis: " & dValue
End Sub
Sub ForNextStepForward()
Dim iCounter As Integer
For iCounter = 1 To 10 Step 2
MsgBox iCounter
Next iCounter
End Sub
Sub ForNextStepBack()
Dim iCounter As Integer
For iCounter = 10 To 1 Step -2
MsgBox iCounter
Next iCounter
End Sub
Sub WhileWend()
Dim iRow As Integer
Dim dValue As Double
iRow = 1
While Not IsEmpty(Cells(iRow, 1))
dValue = dValue + Cells(iRow, 1).Value * 1.2
iRow = iRow + 1
Wend
MsgBox "Ergebnis: " & dValue
End Sub
Sub DoLoop()
Dim iRow As Integer
Dim dValue As Double
iRow = 1
Do
dValue = dValue + Cells(iRow, 1).Value * 1.2
If IsEmpty(Cells(iRow + 1, 1)) Then Exit Do
iRow = iRow + 1
Loop
MsgBox "Ergebnis: " & dValue
End Sub
Sub DoWhile()
Dim iRow As Integer
Dim dValue As Double
iRow = 1
Do While Not IsEmpty(Cells(iRow, 1))
dValue = dValue + Cells(iRow, 1).Value * 1.2
iRow = iRow + 1
Loop
MsgBox "Ergebnis: " & dValue
End Sub
Sub DoUntil()
Dim iRow As Integer
Dim dValue As Double
iRow = 1
Do Until IsEmpty(Cells(iRow, 1))
dValue = dValue + Cells(iRow, 1).Value * 1.2
iRow = iRow + 1
Loop
MsgBox "Ergebnis: " & dValue
End Sub
Sub DoLoopWhile()
Dim iRow As Integer
Dim dValue As Double
iRow = 1
Do
dValue = dValue + Cells(iRow, 1).Value * 1.2
iRow = iRow + 1
Loop While Not IsEmpty(Cells(iRow - 1, 1))
MsgBox "Ergebnis: " & dValue
End Sub
Sub DoLoopUntil()
Dim iRow As Integer
Dim dValue As Double
iRow = 1
Do
dValue = dValue + Cells(iRow, 1).Value * 1.2
iRow = iRow + 1
Loop Until IsEmpty(Cells(iRow, 1))
MsgBox "Ergebnis: " & dValue
End Sub
Sub EachWks()
Dim wks As Worksheet
For Each wks In Worksheets
MsgBox wks.Name
Next wks
End Sub
Sub EachWkbWks()
Dim wkb As Workbook
Dim wks As Worksheet
For Each wkb In Workbooks
For Each wks In wkb.Worksheets
MsgBox wkb.Name & vbLf & " -" & wks.Name
Next wks
Next wkb
End Sub
Sub EachDPWkb()
Dim oDP As DocumentProperty
On Error Resume Next
For Each oDP In ThisWorkbook.BuiltinDocumentProperties
MsgBox oDP.Name & ": " & oDP.Value
Next oDP
On Error GoTo 0
End Sub
Sub EachStylesWkb()
Dim oStyle As Style
For Each oStyle In wkb.Styles
MsgBox oStyle.Name
Next oStyle
End Sub
Sub EachCellWks()
Dim rng As Range
For Each rng In Range("A1:B2")
MsgBox rng.Address(rowabsolute:=False, columnabsolute:=False)
Next rng
End Sub
Sub IfSelected()
Dim oOle As OLEObject
Dim oOpt As msforms.OptionButton
For Each oOle In OLEObjects
If TypeName(oOle.Object) = "OptionButton" Then
Set oOpt = oOle.Object
If oOpt And oOpt.GroupName = "GroupB" Then
MsgBox "In GroupB ist " & oOpt.Caption & " aktiviert"
End If
End If
Next oOle
End Sub
Private Sub cmdRead_Click()
Dim oCntr As msforms.Control
Dim sMsg As String
For Each oCntr In Controls
If TypeName(oCntr) = "CheckBox" Then
If oCntr Then
sMsg = sMsg & " " & oCntr.Name & vbLf
End If
End If
Next oCntr
If sMsg = "" Then
MsgBox "Es wurde keine CheckBox aktiviert!"
Else
MsgBox "Aktivierte CheckBoxes:" & vbLf & sMsg
End If
End Sub
Private Sub cmdAction_Click()
Dim iCounter As Integer
For iCounter = 0 To lstAll.ListCount - 1
If CDate(lstAll.List(iCounter)) >= CDate(txtStart) And _
CDate(lstAll.List(iCounter)) <= CDate(txtEnd) Then
lstFilter.AddItem lstAll.List(iCounter)
End If
Next iCounter
End Sub