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:%
Mostrar la cita

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