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