VBA - PROGRAMMIERUNG -  SCHLEIFEN

'Bei Eintritt bestimmter Ereignisse muß das Programm zu unterschiedlichen Stellen weitergeleitet werden. So zum Beispiel an das Ende des Programmes, wenn ein bestimmter Wert erreicht wurde.
Sub Sprung()
GoTo Weiter
' hier weitere Zeilen
Weiter:
' hier weitere Zeilen
Schluss:
End Sub
 

Sub NachrichtenSchleife()
Antwort = vbYes
Do While Antwort = vbYes
    Antwort = MsgBox("Weitere Daten verarbeiten?", vbYesNo)
Loop
End Sub
 

Sub Dlg_Beispiel()
Dim ZB As Variant, ZB2 As Variant
ZB = InputBox("Zellbezug der zu kopierenden Zelle eingeben:", _
"VBA-Seminar")
ZB2 = InputBox("Zellbezug des Zielortes eingeben:", "VBA-Seminar")
Range(ZB).Select
Selection.Copy
Range(ZB2).Select
ActiveSheet.Paste
MsgBox "Inhalt der Zelle(n) " & ZB & _
    " wurde in Zelle(n) " & ZB2 & " kopiert."
End Sub
 

'Gundprogramm
Sub Dlg_Beispiel0()
Dim ZB As Variant, ZB2 As Variant
'EingabeDlg(Eingabeaufforderung;Titel;Standard;XPos;YPos)
ZB = InputBox("Bitte Zellbezug der zu kopierenden Zelle eingeben:", "VBA-Seminar")
ZB2 = InputBox("Bitte Zellbezug des Zielortes eingeben:", "VBA-Seminar")
Range(ZB).Select
Selection.Kopieren
Range(ZB2).Select
ActiveSheet.Paste
'MeldungsDlg(Meldung;Schaltflächen;Titel;Hilfedatei;Hilfekontext)
'Schaltflächen: 0-OK;1-OK/Abrechen;2-Abruch/Wiederholen;3-Ja/Nein/Abbrechen
'Schaltflächen: 16-Stop;32-?;48-!;64-Info....
MsgBox "Der Inhalt der Zelle " + ZB + " wurde in die Zelle " + ZB2 + " kopiert."
End Sub
 

Sub Dlg_Beispiel2()
Dim ZB As Variant, ZB2 As Variant
ZB = InputBox("Bitte Zellbezug der zu kopierenden Zelle eingeben:", "VBA-Seminar")
ZB2 = InputBox("Bitte Zellbezug des Zielortes eingeben:", "VBA-Seminar")
Range(ZB).Select
Selection.Copy
Range(ZB2).Select
ActiveSheet.Paste
MsgBox "Der Inhalt der Zelle " + ZB + " wurde in die Zelle " + ZB2 + " kopiert."
End Sub
 

'Beispiel für WENN
Sub Wenn_Schleife()
Dim ZB As Variant, ZB2 As Variant
ZB = InputBox("Bitte Zellbezug der zu kopierenden Zelle eingeben:", "VBA-Seminar")
If ZB = "" Then
    MsgBox "Das Makro wird wegen fehlender Eingabewerte beendet", 16
    GoTo Schluss
End If
ZB2 = InputBox("Bitte Zellbezug des Zielortes eingeben:", "VBA-Seminar")
If ZB2 = "" Then
    MsgBox "Das Makro wird wegen fehlendem Zielort beendet", 48
    GoTo Schluss
End If
Range(ZB).Select
Selection.Kopieren
Range(ZB2).Select
ActiveSheet.Paste
MsgBox "Der Inhalt der Zelle " + ZB + " wurde in die Zelle " + ZB2 + " kopiert."
Schluss:
End Sub
 

'FÜR BIS-Schleife
Sub Zähl_Schleife()
Dim i, Zahl As Integer
Zahl = 5
For i = 1 To Zahl
    MsgBox "Die aktuelle Zahl ist " + i
Next
End Sub
 

'SOLANGE BIS-Schleife
Sub Solange_Schleife()
Dim i, Zahl As Integer
i = 1
While i < 5
    MsgBox "Die aktuelle Zahl ist " & i
    i = i + 1
Wend
End Sub
 

Public Function AdditionsSchleife(W As Integer) As Integer
Dim i As Integer
For i = 1 To W Step 1
    AdditionsSchleife = AdditionsSchleife + i
Next
End Function
 

Public Function Fakultaet1(W As Integer) As Double
Dim i As Integer
Fakultaet1 = 1
For i = 1 To W Step 1
    Fakultaet1 = Fakultaet1 * i
Next
End Function
 

Sub Wenn_Funktion()
Dim ZB As Variant, ZB2 As Variant
ZB = InputBox("Bitte Zellbezug der zu kopierenden Zelle eingeben:", "VBA-Seminar")
If ZB = "" Then
    MsgBox "Das Makro wird wegen fehlender Eingabewerte beendet", 16
    GoTo Schluss
End If
ZB2 = InputBox("Bitte Zellbezug des Zielortes eingeben:", "VBA-Seminar")
If ZB2 = "" Then
    MsgBox "Das Makro wird wegen fehlendem Zielort beendet", 48
    GoTo Schluss
End If
Range(ZB).Select
Selection.Copy
Range(ZB2).Select
ActiveSheet.Paste
MsgBox "Der Inhalt der Zelle " + ZB + " wurde in die Zelle " + ZB2 + " kopiert."
Schluss:
End Sub
 

Sub Zähl_Schleife2()
Dim ZB As Variant, ZB2 As Variant, Zahl As Variant
Dim B1 As Range, Zeilenzahl As Integer
ZB = InputBox("Bitte Zellbezug der zu kopierenden Zelle eingeben:", "VBA-Seminar")
ZB2 = InputBox("Bitte Zellbezug des Zielortes eingeben:", "VBA-Seminar")
ZahlEingabe:
Zahl = InputBox("Bitte die Anzahl der zu füllenden Zellen angeben", "VBA-Seminar")
If Zahl = "" Then
    MsgBox "Das Makro wird wegen fehlender Eingabe beendet", 48
    GoTo Schluss
End If
If Zahl > 10 Then
    MsgBox "Die von Ihnen eingegebene Zahl " + Zahl + " ist zu groß. Die größte zulässige Zahl ist 9.", 48
    GoTo ZahlEingabe
End If
For i = 1 To Zahl
    MsgBox "Die aktuelle Zahl ist " + i
Next
Range(ZB).Select
Selection.Copy
Zeilenzahl = Selection.Rows.Count
Range(ZB2, Zahl + Zeilenanzahl).Select
ActiveSheet.Paste
MsgBox "Der Inhalt der Zelle " + ZB + " wurde in die Zelle " + ZB2 + " kopiert."
Schluss:
End Sub
 

Sub Solange_Schleife2()
Dim ZB As Variant, ZB2 As Variant, Zahl As Variant
ZB = InputBox("Bitte Zellbezug der zu kopierenden Zelle eingeben:", "VBA-Seminar")
If ZB = "" Then
    MsgBox "Das Makro wird wegen fehlender Eingabewerte beendet", 16
    GoTo Schluss
End If
ZB2 = InputBox("Bitte Zellbezug des Zielortes eingeben:", "VBA-Seminar")
If ZB2 = "" Then
    MsgBox "Das Makro wird wegen fehlendem Zielort beendet", 48
    GoTo Schluss
End If
ZahlEingabe:
Zahl = InputBox("Bitte die Anzahl der zu füllenden Zellen angeben", "VBA-Seminar")
If Zahl = "" Then
MsgBox "Das Makro wird wegen fehlender Eingabe beendet", 48
GoTo Schluss
End If
If Zahl > 10 Then
    MsgBox "Die von Ihnen eingegebene Zahl " + Zahl + " ist zu groß. " & _
        "Die größte zulässige Zahl ist 9.", 48
    GoTo ZahlEingabe
End If
i = 1
While i < 5
    MsgBox "Die aktuelle Zahl ist " + i
    i = i + 1
Wend
Range(ZB).Select
Selection.Copy
Range(ZB2).Select
Zeilenzahl = Selection.Rows.Count
MsgBox "Zeilenzahl=" + Zeilenzahl
Range(ZB2, Cells(Zeilenanzahl + Zahl, 1)).Select
ActiveSheet.Paste
MsgBox "Der Inhalt der Zelle " + ZB + " wurde in die Zelle " + ZB2 + " kopiert."
Schluss:
End Sub
 

Sub Schleife1()
Dim i
For i = 1 To 10
    If i > 5 Then Exit For
    Debug.Print i
Next i
End Sub
 

Sub Schleife2()
Dim i As Double
For i = -0.3 To 0.3 Step 0.1
    Debug.Print i
Next i
End Sub
 

Sub Schleife3()
Dim i
For Each i In Application.Sheets
    Debug.Print i.Name
Next i
End Sub
 

Sub Schleife4()
Dim i
For i = 1 To Application.Sheets.Count
    Debug.Print Application.Sheets(i).Name
Next i
End Sub
 

Sub endlos()
Do
    Debug.Print "und so weiter"
Loop
End Sub
 

Sub Schleife5()
Dim i As Integer
i = 1
    Do
    Debug.Print i
    i = i + 1
Loop Until i > 10
End Sub
 

Sub WennDann()
Dim Zahl
Zahl = InputBox("Geben Sie eine Zahl ein!")
If Not IsNumeric(Zahl) Then
    MsgBox "Das ist keine Zahl"
ElseIf Zahl > 10 Then
    MsgBox "Die Zahl ist größer 10"
Else
    MsgBox "Die Zahl ist kleiner oder gleich 10"
End If
End Sub
 

Sub FülleZellen()
Dim i As Integer, j As Integer, k As Integer
Dim R0 As Range, R1 As Range, R2 As Range
Dim Zellen(9, 9)
Worksheets("SCHLEIFENTEST").Activate
Worksheets("SCHLEIFENTEST").[a1].CurrentRegion.Clear
Application.ScreenUpdating = False
Application.Calculation = xlManual
For i = 0 To 9 ' Zeilen
    For j = 0 To 9 ' Spalten
        k = i * 100 + j
        Zellen(i, j) = k * 2
    Next
Next
' Zielbereich ermitteln
Set R1 = Worksheets(1).[a1]
Set R2 = R1.Offset(9, 9)
Set R0 = Worksheets(1).Range(R1, R2)
R0 = Zellen
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Beep
End Sub