Private Function ZufallszahlenOhneZuruecklegen(Min As Long, Max As Long, Anzahl _
  As Long) As Long()
    If Anzahl > Max - Min + 1 Then Anzahl = Max - Min + 1
    Dim arr() As Long
    ' Alle zulässigen Werte ins Array schreiben
    ReDim arr(Max - Min)
    Dim i As Long
    For i = 0 To Max - Min
       arr(i) = i + Min
    Next i
 
    Dim index As Long, tmp As Long
    For i = 0 To Anzahl - 1
        'Index des neuen Elements ermitteln (im hinteren Bereich)
        index = Int(Rnd * (UBound(arr) + 1 - i)) + i
        'Zahlen tauschen
        tmp = arr(i)
        arr(i) = arr(index)
        arr(index) = tmp
    Next i
    If Anzahl < UBound(arr) + 1 Then ReDim Preserve arr(Anzahl - 1)
    ZufallszahlenOhneZuruecklegen = arr
End Function

Dim Lottozahlen() as Long
Lottozahlen = ZufallszahlenOhneZuruecklegen(1, 49, 6)