logische systeme

Man erstelle ein Modul und kopiere den Code unten hinein und entferne ggf. die Zeilenumbrüche.

Als dann rufe man das Bundesland etwa so ab:
 

Me!Bundesland = GetBundeslandFromPlz(Me!Plz)

oder in einer Abfrage:

Bundesland: GetBundeslandFromPlz([Plz])

-------------------------------------------------------------------------------

option Explicit

'--------------------------------------------------
' Bundesland aus einer Postleitzahl ermitteln
' ohne Zusatztabellen
'--------------------------------------------------
Function GetBundeslandFromPlz(p As Variant, Optional ShowNames As Boolean = False) As Variant
'ermittelt Bundesland aus uebergebener Plz
'optional wird Zahl oder Wert zurückgegeben
Dim i, b As Integer
Dim Bounds, LCs, Lnamen As Variant   

If IsNull(p) Or p = "" Then
        GetBundeslandFromPlz = 0
        Exit Function
End If  

Bounds = Array(1000, 1945, 2625, 3000, 4000, 4600, 4639, 4640, 4895, 4896, 6100, 6556, 6567, 6568, 6618, 7318, _

7919, 7920, 7952, 7953, 7985, 7986, 8000, 10000, 12529, 14715, 14716, 17030, 17248, 17249, 17258, _
                17259, 17268, 17309, 17310, 17326, 17328, 17335, 17336, 19309, 19357, 19358, 20000, 21039, 21200, _
                21465, 21522, 21524, 21614, 22113, 23900, 23909, 23923, 24100, 26100, 27498, 27499, 27500, 27607, _
                28000, 28790, 29410, 29439, 32000, 34100, 34346, 34359, 34414, 34454, 36404, 37000, 37194, 37195, _
                37210, 37308, 37412, 37696, 37697, 38486, 38518, 38820, 40000, 48455, 48477, 48480, 48485, 48488, _
                48493, 48499, 48565, 49000, 49470, 49565, 50000, 51598, 51640, 53424, 53604, 53619, 53639, 54290, _
                55246, 55257, 57000, 57518, 58000, 59969, 59970, 63700, 63776, 63777, 63928, 63929, 64200, 64754, _
                64755, 65391, 65392, 65558, 65589, 65623, 65627, 65629, 65719, 66100, 66482, 66500, 66501, 66557, _
                66849, 68000, 68519, 68526, 68623, 68723, 69239, 69242, 69434, 69435, 69483, 69493, 69509, 69514, _
                69517, 70000, 74594, 74595, 76726, 77650, 80000, 88040, 88131, 88147, 88148, 88210, 89230, 89500, _
                90400, 96515, 97000, 97877, 97892, 97896, 97897, 97901, 97922, 98520, 99999)    LCs = Array(14, 12, 14, 12, 14, 16, 1416, 14, 1215, 12, 15, 16, 1516, 16, 15, 16, 1416, 16, 1416, 16, 1416, _
                16, 14, 11, 12, 1215, 12, 13, 1213, 13, 1213, 13, 12, 1213, 13, 12, 13, 1213, 13, 12, 1213, 13, _
                2, 1, 3, 1, 3, 1, 3, 1, 13, 1, 13, 1, 3, 1, 2, 4, 3, 4, 3, 15, 3, 5, 6, 3, 6, 5, 6, 16, 3, 306, _
                3, 6, 16, 3, 5, 3, 15, 3, 15, 5, 3, 5, 3, 5, 3, 5, 3, 5, 3, 5, 3, 5, 7, 5, 7, 5, 7, 5, 7, 6, 7, _
                5, 7, 5, 506, 6, 9, 609, 9, 809, 9, 6, 608, 6, 607, 6, 7, 6, 7, 6, 7, 6, 10, 7, 710, 7, 10, 7, _
                8, 6, 8, 6, 8, 6, 8, 608, 8, 6, 8, 6, 8, 6, 8, 809, 8, 7, 8, 9, 8, 9, 809, 9, 8, 9, 8, 9, 16, 9, _
                8, 9, 809, 8, 9, 8, 16)

If ShowNames Then
        Lnamen = Array("UNBEKANNT", "Schleswig-Holstein", "Hamburg", "Niedersachsen", "Bremen", "Nordrhein-Westfalen", _
                "Hessen", "Rheinland-Pfalz", "Baden-Württemberg", "Bayern", "Saarland", "Berlin", "Brandenburg", _
                "Mecklenburg-Vorpommern", "Sachsen", "Sachsen-Anhalt", "Thüringen")
End If   

    b = 0
    p = Val(p)
    If ((p > 999) And (p < 99999)) Then
        i = 0
        While (Bounds(i) <= p)
            i = i + 1
        Wend
        b = LCs(i - 1)
    End If

    If ShowNames Then
        If (b > 100) Then
            GetBundeslandFromPlz = Lnamen(Int(b / 100)) & " und " & Lnamen(b Mod 100)
        Else
            GetBundeslandFromPlz = Lnamen(b)
        End If
    Else
        GetBundeslandFromPlz = b
    End If

End Function