Startseite

Die Select-Case-Anweisung

Genau wie die If-Anweisung, gehört die Select-Anweisung zu den Verzweigungen. Die Select-Anweisung ist eine Mehrfachauswahl. Mit ihrer Hilfe kann man aus einer Vielzahl von Möglichkeiten auswählen.

Beispiel 1:

Sub analyse1()
Dim we%
z = 2
Do While Cells(z, 1) <> ""
    we = Cells(z, 1)
        Select Case we
            Case Is < 10
                Cells(z, 2) = " Wert ist kleiner als 10"
            Case Is < 20
                Cells(z, 2) = " Wert ist kleiner als 20"
            Case Is < 30
                Cells(z, 2) = " Wert ist kleiner als 30"
            Case Is < 40
                Cells(z, 2) = " Wert ist kleiner als 40"
            Case Is < 50
                Cells(z, 2) = " Wert ist kleiner als 50"
        End Select
    z = z + 1
Loop
Wichtig ist dabei die Reihenfolge der Anweisungen. Im ersten Beispiel wurde herausgesucht, welcher Wert kleiner als eine Vorgabe war. Im nächsten Beipiel habe ich das umgedreht. Nun muß die Auswahl bei der größten Möglichkeit beginnen, da immer dann, wenn eine Bedingung erfüllt ist, die entsprechende Anweisung ausgeführt wird.

Beispiel 2:

Sub analyse2()
Dim we%
z = 2
    Do While Cells(z, 1) <> ""
        we = Cells(z, 1)
            Select Case we
            Case Is > 40
                Cells(z, 2) = " Wert ist größer als 40"
            Case Is > 30
                Cells(z, 2) = " Wert ist größer als 30"
            Case Is > 20
                Cells(z, 2) = " Wert ist größer als 20"
            Case Is > 10
                Cells(z, 2) = " Wert ist größer als 10"
            Case Is < 10
                Cells(z, 2) = " Wert ist kleiner als 10"
        End Select
    z = z + 1
Loop
End Sub

Die Select-Case-Anweisung mit For To Next kombiniert

Wenn es gilt, eine große Anzahl Werte abzugleichen, kann man das mit einer For To Next-Schleife kombinieren. Als Beispiel ein Makro, mit dem ich versucht habe, über die Namensendungen Vornamen einem Geschlecht zuzuordnen. Weitere Kürzel können in die Arrays eingetragen werden, eine Anpassung des Makros ist nicht erforderlich, da die UBound-Anweisung die Anzahl der Daten ermittelt. 
Option Explicit
Sub geschlecht_nach_vornamen()
' Variablen deklarieren
Dim arrw As Variant
Dim arrm As Variant
Dim arru As Variant
Dim s As Integer
Dim t As Integer
' Werte an Arrays zuweisen
arrw = Array("ana", "ane", "ara", "eth", "bet", "dia", "dra", "een", "ela", "ele", "ena", _
"ett", "fer", "git", "hia", "hie", "ica", "ika", "ike", "ina", "ine", "isa", "Lea", "lia", _
"lin", "lke", "ndy", "nes", "nie", "nja", "nke", "nna", "nne", "ole", "one", "rah", "rea", _
"ria", "rie", "rin", "ska", "ssa", "tin", "tja", "tje", "tra", "tte", "ula", "ura", "Uta", _
"Ute", "kia", "ate", "idi", "osi")
arrm = Array("ael", "aik", "alf", "ang", "ank", "ars", "aul", "aus", "cel", "cha", "der", _
"eas", "ené", "ens", "eon", "erd", "ert", "fan", "fen", "gen", "ger", "han", "har", "her", _
"ian", "ias", "ich", "ick", "ied", "iel", "iet", "inz", "ipp", "irk", "Jan", "kas", "kus", _
"las", "lef", "lix", "lph", "mas", "Max", "min", "nas", "nik", "nis", "nut", "olf", "örg", _
"rco", "red", "ric", "rik", "rio", "rko", "rnd", "ten", "ter", "Tim", "Tom", "Uwe", "ven", _
"vid", "vin", "wen")
arru = Array("ike", "tin")
' Übereinstimmungen suchen
For s = 2 To Range("A65536").End(xlUp).Row  ' Schleifenstart (Tabelleninhalte)
' Auf weibliche Vornamen prüfen
    For t = 0 To UBound(arrw)               ' Schleifenstart für 1. Array
        Select Case Right(Cells(s, 1), 3)   ' Vergleichswert zuweisen (letzte 3 Buchstaben der akt. Zelle)
            Case arrw(t)                    ' wenn Vergleichswert aus Array gleich dann ...
            Cells(s, 2) = "w"               ' ... Kennung in Zelle schreiben
        End Select                          ' Ausstieg wenn Übereinstimmung
    Next t                                  ' Wendepunkt für Schleife (1. Array)
' Auf männliche Vornamen prüfen
    For t = 0 To UBound(arrm)               ' Schleifenstart für 2. Array
        Select Case Right(Cells(s, 1), 3)   ' Vergleichswert zuweisen
            Case arrm(t)                    ' wenn Vergleichswert aus Array gleich dann ...
            Cells(s, 2) = "m"               ' ... Kennung in Zelle schreiben
    End Select                              ' Ausstieg wenn Übereinstimmung
    Next t                                  ' Wendepunkt für Schleife (2. Array)
' Auf unklare Ergebnisse prüfen
    For t = 0 To UBound(arru)               ' Schleifenstart für 3. Array
        Select Case Right(Cells(s, 1), 3)   ' Vergleichswert zuweisen
            Case arru(t)                    ' wenn Vergleichswert aus Array gleich dann ...
            Cells(s, 2) = "m w"             ' ... Kennung in Zelle schreiben
    End Select                              ' Ausstieg wenn Übereinstimmung
    Next t                                  ' Wendepunkt für Schleife (3. Array)
Next s                                      ' Wendepunkt für Schleife (Tabelleninhalte)
End Sub

Code eingefügt mit: Excel Code Jeanie