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

[BlackZeroX]

.
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 [Seleccionar] Expandir


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 (Vb) [Seleccionar] Expandir



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 [Seleccionar] Expandir



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!¡.

[Psyke1]

 
Precioso, justo yo también estaba intentando hacer algo así.
Pero mi idea era llenar ya directamente la matriz, con excepciones incluidas, me explico:

Código (vb) [Seleccionar] Expandir

sub CargarMatrizAleatoria(Min as long, Max as long, Excepciones() as long, lOutputArr() as long)
La semana que viene a ver si tengo tiempo e intento hacer algo.

DoEvents!

[seba123neo]

estoy tratando de descifrar todavia que es la palabra "esecciones"  , te modifique el titulo del post...me falto cambiar esa palabra en el codigo.

[BlackZeroX]

@Psyke1

Mas que una matriz quedaría precioso en una clase... al rato lo traslado a una clase para aumentar la velocidad de procesamiento, ya que de este modo se le aumenta el peformance ( en relación procesador/tiempo, pero no memoria ) con una clase.

@seba123neo

Te juro que busque con google como escribirla....
.

Dulces Lunas!¡.