.
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.
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)
}
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:
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!¡.
:o
Precioso, justo yo también estaba intentando hacer algo así. :xD :silbar:
Pero mi idea era llenar ya directamente la matriz, con excepciones incluidas, me explico:
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! :P
estoy tratando de descifrar todavia que es la palabra "esecciones" :xD, te modifique el titulo del post...me falto cambiar esa palabra en el codigo.
@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!¡.