[source] Numeros Aleatorio desde X a Y con excepciones.

.
Lo que hace este código es que crea numero aleatorio desde un valor mínimo a uno valor máximo pero si se encuentra un numero Z entre los mismo JAMAS saldrá como numero aleatorio.

Una breve introducción antes del código fuente...

Aun no pruebo la velocidad...

OJO: Las esecciones no deben repetirse.

Código:

NumerosAleatoriosEx (Numero Inicio, Numero Final, Array de valores a no considerar) {
MatrixRangos() = Realizar una búsqueda de valores para verificar si alguno de los numeros del array estan entre el valor de Inicio o el valor del Final: (un For Next bastara) , y generamos cortes de array's por ejemplo ( Inicio=0 final=10 array={5,8} este paso genera 3 array que son: {0,4},{6,7},{9,10} )
iIndice = Generamos un numero aleatorio desde Lbound(MatrixRangos()) hasta Ubound(MatrixRangos())
Retornamos el numero que se genera un numero aleatorio según los rangos que indique MatrixRangos( iIndice )(0) y MatrixRangos( iIndice )(1)
}

Código

 
Option Explicit
 
Private Type stRangos
    lValIni         As Long
    lValEnd         As Long
End Type
 
Public Sub swapNumbers(ByRef lValOne As Long, ByRef lValTwo As Long)
Dim lValTmp         As Long
    lValTmp = lValOne
    lValOne = lValTwo
    lValTwo = lValTmp
End Sub
 
Public Function FixNumbers(ByRef lValMin As Long, lValMax As Long) As Boolean
    If lValMax < lValMin Then
        Call swapNumbers(lValMin, lValMax)
        FixNumbers = True
    End If
End Function
 
Public Function NumeroAleatorio(lValMin As Long, lValMax As Long) As Long
    Call FixNumbers(lValMin, lValMax)
    Call Randomize
    NumeroAleatorio = (lValMin - lValMax) * Rnd + lValMax
End Function
 
Public Function NumeroAleatorioEx(ByVal lValIni As Long, ByVal lValEnd As Long, ParamArray aNoRepet() As Variant) As Long
'   //  Debera pasarse el parametro {aNoRepet} ordenado de menor a mayor ( indice lbound siendo el valor menor y ubound el valor mayor ).
'   //  La funcion Si no puede generar un numero aleatorio retornara {lValIni-1}
On Error GoTo GetNumber
Dim avArray()       As Variant
Dim lUB             As Long
Dim lNextVal        As Long
Dim li              As Long, lIndex         As Long
Dim tRangos()       As stRangos
 
    If (Not IsMissing(aNoRepet)) Then
        If (IsArray(aNoRepet(0))) Then
            avArray = aNoRepet(0)
        Else
            avArray = aNoRepet
        End If
 
        lUB = UBound(avArray)
        Call Start_QuickSort(avArray, AcendetOrder)     '   //  http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=14:artquicksortybublesort&catid=2:catprocmanager&Itemid=8
        
        ReDim tRangos(0 To (lUB + 1))                   '   //  Cache de memoria...
        With tRangos(0)
            .lValIni = lValIni
            .lValEnd = lValEnd
        End With
        lNextVal = lValIni
        lIndex = 0
 
        For li = 0 To lUB
            If (avArray(li) <= lValEnd And _
                avArray(li) > lValIni And _
                lNextVal <> avArray(li)) Then
                If (lNextVal > lValIni) Then
                    lIndex = lIndex + 1
                    With tRangos(lIndex)
                        .lValIni = lNextVal
                        .lValEnd = avArray(li) - 1
                    End With
                    lNextVal = (avArray(li) + 1)
 
                ElseIf (lNextVal = lValIni) Then
                    tRangos(lIndex).lValEnd = avArray(li) - 1
                    lNextVal = (avArray(li) + 1)
 
                End If
            ElseIf (avArray(li) = tRangos(0).lValIni) Then
                lIndex = lIndex - 1
                lNextVal = tRangos(0).lValIni + 1
            Else
                lNextVal = lNextVal + 1
            End If
        Next
 
        If (lIndex > -1) Then
            If ((tRangos(lIndex).lValEnd + 1) <= lValEnd And lNextVal <= lValEnd) Then
                lIndex = lIndex + 1
                ReDim Preserve tRangos(0 To lIndex)
                With tRangos(lIndex)
                    .lValIni = avArray(lUB) + 1
                    .lValEnd = lValEnd
                End With
            Else
                ReDim Preserve tRangos(0 To lIndex)
            End If
 
        ElseIf (lNextVal > lValEnd) Then
            NumeroAleatorioEx = lValIni - 1
            Exit Function
 
        Else
            lIndex = 0
            tRangos(lIndex).lValIni = lNextVal
 
        End If
 
        li = NumeroAleatorio(0, lIndex)
        NumeroAleatorioEx = NumeroAleatorio(tRangos(li).lValIni, tRangos(li).lValEnd)
        Exit Function
 
    End If
GetNumber:
    NumeroAleatorioEx = NumeroAleatorio(lValIni, lValEnd)
End Function
 
Private Sub Form_Load()
Dim ii              As Integer
Dim lres            As Long
Dim vArray()        As Variant
 
Const lValIni       As Long = 5
Const lValEnd       As Long = 10
 
    lres = NumeroAleatorioEx(lValIni, lValEnd)
    ReDim vArray(0 To 0)
    vArray(ii) = lres
    Debug.Print lres
    For ii = 1 To 11
        lres = NumeroAleatorioEx(lValIni, lValEnd, vArray)
        ReDim Preserve vArray(0 To ii)
        vArray(ii) = lres
        If (lres = (lValIni - 1)) Then
            Debug.Print "Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones."
        Else
            Debug.Print lres
        End If
    Next ii
End Sub

Salida del ejemplo:

Código:

10
7
9
8
6
5
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.

Temibles Lunas!¡.