Ayuda con VBA

He pensado que mejor que tener que entrar en la lógica del código que has puesto era escribir uno nuevo:

Sub CrearMatrizDobleAleatoria()
Dim wksH As Worksheet
Dim mtr(1 To 2, 1 To 999), n As Byte, j As Integer, intRnd As Integer

Application.ScreenUpdating = False

Set wksH = ThisWorkbook.Worksheets.Add

For n = 1 To 2
wksH.Range("A1:A999") = "=row()"
wksH.Range("A1:A999").Copy
wksH.Range("A1:A999").PasteSpecial Paste:=xlValues, Operation:=xlNone

Application.CutCopyMode = False

For j = 1 To 999

intRnd = Int(((999 + 1 - j) * Rnd) + 1)
mtr(n, j) = wksH.Cells(intRnd, 1)
wksH.Rows(intRnd).Delete

Next j
Next n

'Si lo que necesitas es la matriz, borra o desactiva las siguientes líneas (se encargan de volcar la matriz en la hoja)
For j = 1 To 999
wksH.Cells(j, 1) = mtr(1, j)
wksH.Cells(j, 2) = mtr(2, j)
Next j

'Si lo que necesitas es la matriz, activa las siguientes instrucciones (se encargan de borrar la hoja)
'Application.DisplayAlerts = False
'wksH.Delete
'Application.DisplayAlerts = True

Application.ScreenUpdating = True

Set wksH = Nothing
End Sub


Naturalmente, sólo funcionará en Excel.
Igual está mal que lo diga yo, pero me ha sorprendido lo rápido que es.
Creo que funciona bien porque la suma de cada columna es siempre 499500 y la suma de las diferencias de cada par de elementos es cero, pero tendrás que verificarlo.
Un saludo.


Fernando Arroyo
MS MVP - Excel


"Mario Alberto Rodríguez Soto" escribió en el mensaje news:%

Hola.:

Tengo el siguiente código para efectuar obtener pares de números al azar
entre el 1 y el 999, sin embargo, después de ejecutarlo encuentro números
repetidos y no tengo idea de que agregar para evitar esto.

Gracias de antemano.

Mario Alberto

Option Explicit
Option Base 1
Public jj As Long
Public Const iteration = 500
'*****************
'* Resampling Process
*
'*****************

Sub Resample()
Dim i As Long
Dim hold(999) As Single, Hold2(999) As Single
Randomize

For i = 1 To 999
Hold2(i) = i
Next i
For jj = 1 To iteration
For i = 1 To 999
hold(i) = Rnd
Next i
Call DoubleSort(999, hold, Hold2)
For i = 1 To 2
Cells(jj + 3, i) = Hold2(i)
Next i
Next jj
End Sub

'**************************************
'*Sorting Process - Sort array y based on array x
*
'**************************************

Sub DoubleSort(n As Long, x() As Single, y() As Single)
Dim xTemp As Double
Dim yTemp As Double
Dim i As Long
Dim j As Long

For j = 2 To n
xTemp = x(j)
yTemp = y(j)
For i = j - 1 To 1 Step -1
If (x(i) <= xTemp) Then GoTo 10
x(i + 1) = x(i)
y(i + 1) = y(i)
Next i
i = 0
10 x(i + 1) = xTemp
y(i + 1) = yTemp
Next j
End Sub

Gracias Fernando.

El código que me facilitaste funciona muy bien, sin embargo tengo otra
pregunta, que necesito cambiar para que únicamente me de quinientos pares de
números.

Si no mal entendí la lógica seria en:
wksH.Range("A1:A500")
Estoy en lo correcto

De antemano gracias.

Saludos.

"Fernando Arroyo" escribió en el mensaje
news:OWqSb$
He pensado que mejor que tener que entrar en la lógica del código que has
puesto era escribir uno nuevo:

Sub CrearMatrizDobleAleatoria()
Dim wksH As Worksheet
Dim mtr(1 To 2, 1 To 999), n As Byte, j As Integer, intRnd As Integer

Application.ScreenUpdating = False

Set wksH = ThisWorkbook.Worksheets.Add

For n = 1 To 2
wksH.Range("A1:A999") = "=row()"
wksH.Range("A1:A999").Copy
wksH.Range("A1:A999").PasteSpecial Paste:=xlValues,
Operation:=xlNone

Application.CutCopyMode = False

For j = 1 To 999

intRnd = Int(((999 + 1 - j) * Rnd) + 1)
mtr(n, j) = wksH.Cells(intRnd, 1)
wksH.Rows(intRnd).Delete

Next j
Next n

'Si lo que necesitas es la matriz, borra o desactiva las siguientes
líneas (se encargan de volcar la matriz en la hoja)
For j = 1 To 999
wksH.Cells(j, 1) = mtr(1, j)
wksH.Cells(j, 2) = mtr(2, j)
Next j

'Si lo que necesitas es la matriz, activa las siguientes instrucciones
(se encargan de borrar la hoja)
'Application.DisplayAlerts = False
'wksH.Delete
'Application.DisplayAlerts = True

Application.ScreenUpdating = True

Set wksH = Nothing
End Sub


Naturalmente, sólo funcionará en Excel.
Igual está mal que lo diga yo, pero me ha sorprendido lo rápido que es.
Creo que funciona bien porque la suma de cada columna es siempre 499500 y la
suma de las diferencias de cada par de elementos es cero, pero tendrás que
verificarlo.
Un saludo.


Fernando Arroyo
MS MVP - Excel


"Mario Alberto Rodríguez Soto" escribió en el
mensaje news:%

Hola.:

Tengo el siguiente código para efectuar obtener pares de números al azar
entre el 1 y el 999, sin embargo, después de ejecutarlo encuentro números
repetidos y no tengo idea de que agregar para evitar esto.

Gracias de antemano.

Mario Alberto

Option Explicit
Option Base 1
Public jj As Long
Public Const iteration = 500
'*****************
'* Resampling Process
*
'*****************

Sub Resample()
Dim i As Long
Dim hold(999) As Single, Hold2(999) As Single
Randomize

For i = 1 To 999
Hold2(i) = i
Next i
For jj = 1 To iteration
For i = 1 To 999
hold(i) = Rnd
Next i
Call DoubleSort(999, hold, Hold2)
For i = 1 To 2
Cells(jj + 3, i) = Hold2(i)
Next i
Next jj
End Sub

'**************************************
'*Sorting Process - Sort array y based on array x
*
'**************************************

Sub DoubleSort(n As Long, x() As Single, y() As Single)
Dim xTemp As Double
Dim yTemp As Double
Dim i As Long
Dim j As Long

For j = 2 To n
xTemp = x(j)
yTemp = y(j)
For i = j - 1 To 1 Step -1
If (x(i) <= xTemp) Then GoTo 10
x(i + 1) = x(i)
y(i + 1) = y(i)
Next i
i = 0
10 x(i + 1) = xTemp
y(i + 1) = yTemp
Next j
End Sub

Para que fueran 500 pares habría que cambiar unas cuantas líneas, así que he modificado el código para que se pueda establecer cualquier número de pares. Tan sólo hay que cambiar la primera instrucción.


Private Const intNúmElementos As Integer = 500 'Número de "pares" que tendrá la matriz

Sub CrearMatrizDobleAleatoria()
Dim wksH As Worksheet
Dim mtr(1 To 2, 1 To intNúmElementos), n As Byte, j As Integer, intRnd As Integer

Application.ScreenUpdating = False

Set wksH = ThisWorkbook.Worksheets.Add

For n = 1 To 2
wksH.Range("A1:A" & intNúmElementos) = "=row()"
wksH.Range("A1:A" & intNúmElementos).Copy
wksH.Range("A1:A" & intNúmElementos).PasteSpecial Paste:=xlValues, Operation:=xlNone

Application.CutCopyMode = False

For j = 1 To intNúmElementos

intRnd = Int(((intNúmElementos + 1 - j) * Rnd) + 1)
mtr(n, j) = wksH.Cells(intRnd, 1)
wksH.Rows(intRnd).Delete

Next j
Next n

'Si lo que necesitas es la matriz, borra o desactiva las siguientes líneas (se encargan de volcar la matriz en la hoja)
For j = 1 To intNúmElementos
wksH.Cells(j, 1) = mtr(1, j)
wksH.Cells(j, 2) = mtr(2, j)
Next j

'Si lo que necesitas es la matriz, activa las siguientes instrucciones (se encargan de borrar la hoja)
'Application.DisplayAlerts = False
'wksH.Delete
'Application.DisplayAlerts = True

Application.ScreenUpdating = True

Set wksH = Nothing
End Sub


Un saludo.


Fernando Arroyo
MS MVP - Excel


"Mario Alberto Rodríguez Soto" escribió en el mensaje news:%

Gracias Fernando.

El código que me facilitaste funciona muy bien, sin embargo tengo otra
pregunta, que necesito cambiar para que únicamente me de quinientos pares de
números.

Si no mal entendí la lógica seria en:
wksH.Range("A1:A500")
Estoy en lo correcto

De antemano gracias.

Saludos.

Pero ¿qué entiendes por "sin que se repitan los números"?:
- que un número que está en la "columna" 1 de la matriz no pueda estar en la "columna" 2, es decir, necesitas distribuir de forma aleatoria los números del 0 al 999 en dos listas de 500
- o que un número no pueda estar más de una vez en cada una de las "columnas" de la matriz, pero sí pueda estar en ambas
Un saludo.


Fernando Arroyo
MS MVP - Excel


"Mario Alberto Rodríguez Soto" escribió en el mensaje news:

Gracias nuevamente, sin embargo aún no he resulto mi problema de que sean
500 pares de numeros del 0 al 999, sin que se repitan los números, para
ejemplificar un poco tendría lo siguiente:

NUM1 NUM2
325 25
459 999
789 128
...
Lo que deseo es que ninguno de estos números se repita nuevamente en la
lista, es decir, hacer un sorteo al azar.

Saludos

"Fernando Arroyo" escribió en el mensaje
news:%
Para que fueran 500 pares habría que cambiar unas cuantas líneas, así que he
modificado el código para que se pueda establecer cualquier número de pares.
Tan sólo hay que cambiar la primera instrucción.


Private Const intNúmElementos As Integer = 500 'Número de "pares" que tendrá
la matriz

Sub CrearMatrizDobleAleatoria()
Dim wksH As Worksheet
Dim mtr(1 To 2, 1 To intNúmElementos), n As Byte, j As Integer, intRnd
As Integer

Application.ScreenUpdating = False

Set wksH = ThisWorkbook.Worksheets.Add

For n = 1 To 2
wksH.Range("A1:A" & intNúmElementos) = "=row()"
wksH.Range("A1:A" & intNúmElementos).Copy
wksH.Range("A1:A" & intNúmElementos).PasteSpecial Paste:=xlValues,
Operation:=xlNone

Application.CutCopyMode = False

For j = 1 To intNúmElementos

intRnd = Int(((intNúmElementos + 1 - j) * Rnd) + 1)
mtr(n, j) = wksH.Cells(intRnd, 1)
wksH.Rows(intRnd).Delete

Next j
Next n

'Si lo que necesitas es la matriz, borra o desactiva las siguientes
líneas (se encargan de volcar la matriz en la hoja)
For j = 1 To intNúmElementos
wksH.Cells(j, 1) = mtr(1, j)
wksH.Cells(j, 2) = mtr(2, j)
Next j

'Si lo que necesitas es la matriz, activa las siguientes instrucciones
(se encargan de borrar la hoja)
'Application.DisplayAlerts = False
'wksH.Delete
'Application.DisplayAlerts = True

Application.ScreenUpdating = True

Set wksH = Nothing
End Sub


Un saludo.


Fernando Arroyo
MS MVP - Excel

Ahora sí que creo que no se nos escapa: lo tenemos rodeado :-)
Prueba con:


Private Const intNúmElementos As Integer = 500 'Número de "pares" que tendrá la matriz

Sub CrearMatrizDobleAleatoria()
Dim wksH As Worksheet
Dim mtr(1 To 2, 1 To intNúmElementos), j As Integer, intRnd As Integer

Application.ScreenUpdating = False

Set wksH = ThisWorkbook.Worksheets.Add

wksH.Range("A1:A" & intNúmElementos * 2) = "=row()"
wksH.Range("A1:A" & intNúmElementos * 2).Copy
wksH.Range("A1:A" & intNúmElementos * 2).PasteSpecial Paste:=xlValues, Operation:=xlNone

Application.CutCopyMode = False

For j = 1 To intNúmElementos * 2

intRnd = Int((((intNúmElementos * 2) + 1 - j) * Rnd) + 1)
mtr(IIf(j <= intNúmElementos, 1, 2), IIf(j <= intNúmElementos, j, j - intNúmElementos)) = wksH.Cells(intRnd, 1) - 1
wksH.Rows(intRnd).Delete

Next j

'Si lo que necesitas es la matriz, borra o desactiva las siguientes líneas (se encargan de volcar la matriz en la hoja)
For j = 1 To intNúmElementos
wksH.Cells(j, 1) = mtr(1, j)
wksH.Cells(j, 2) = mtr(2, j)
Next j

'Si lo que necesitas es la matriz, activa las siguientes instrucciones (se encargan de borrar la hoja)
'Application.DisplayAlerts = False
'wksH.Delete
'Application.DisplayAlerts = True

Application.ScreenUpdating = True

Set wksH = Nothing
End Sub


Un saludo.


Fernando Arroyo
MS MVP - Excel



"Mario Alberto Rodríguez Soto" escribió en el mensaje news:

Fernando como bien lo expones, lo que quiero es la primera opción:

"que un número que está en la "columna" 1 de la matriz no pueda estar en la
"columna" 2, es decir, necesitas distribuir de forma aleatoria los números
del 0 al 999 en dos listas de 500"

Perdón por no haber sido claro desde el primer mensaje.

Saludos

"Fernando Arroyo" escribió en el mensaje
news:
Pero ¿qué entiendes por "sin que se repitan los números"?:
- que un número que está en la "columna" 1 de la matriz no pueda estar en
la "columna" 2, es decir, necesitas distribuir de forma aleatoria los
números del 0 al 999 en dos listas de 500
- o que un número no pueda estar más de una vez en cada una de las
"columnas" de la matriz, pero sí pueda estar en ambas
Un saludo.


Fernando Arroyo
MS MVP - Excel


"Mario Alberto Rodríguez Soto" escribió en el
mensaje news:
> Gracias nuevamente, sin embargo aún no he resulto mi problema de que sean
> 500 pares de numeros del 0 al 999, sin que se repitan los números, para
> ejemplificar un poco tendría lo siguiente:
>
> NUM1 NUM2
> 325 25
> 459 999
> 789 128
> ...
> Lo que deseo es que ninguno de estos números se repita nuevamente en la
> lista, es decir, hacer un sorteo al azar.
>
> Saludos
>