Jump to content

Crear pares de números no repetidos con random


Recommended Posts

Buenas,

Tengo una macro donde creo dos listas con random. La unión de las dos listas son pares de números que indican una determinada celda, y necesito que no aparezca dos veces la misma celda. He encontrado ejemplos de como evitar repeticiones de números con random, pero lo que yo quiero es que no se repita el par. alguien puede echarme una mano?

Muchas gracias por adelantado!

Link to comment
Share on other sites

Hola Nvidia

Bienvenido al Foro, te recomiendo que subas un archivo (Zipiado preferiblemente del 2003) como exigen las Normas del Foro, coloca tus datos (pueden ser ficticios) y manualmente lo que necesitas, las posibilidades de que te respondan pueden aumentar, recuerda que para nosotros (los que preguntamos) lo tenemos muy claro, lo difícil es trasmitir nuestras dudas y que nos entiendan.

Además si visitas al final de la página los Temas Similares, te dan una pista sobre tu Post.

Saludos

Lázaro.

Link to comment
Share on other sites

No tengo ningún archivo para subir, pero me explico mejor:

Uso dos veces random, con el primero genero el vector fila y con el segundo el vector columna, cada uno de 10 elementos.

cada par Fila(i)Columna(i) me determina una celda aleatoria dentro del rango de celdas de (2,2) hasta (11,8). Estas 10 celdas deben tomar el valor 10.

For i = 0 To 9

a = Int((10 * Rnd) + 2)

b = Int((7 * Rnd) + 2)

fila(i) = a

columna(i) = b

Cells(a, B) = 10

Next i

Y lo que quiero es evitar que me devuelva dos veces la misma celda, ya que necesito que 10 celdas valgan "10".

Espero que así quede más claro. Gracias!

Link to comment
Share on other sites

Tengo una macro donde creo dos listas con random. La unión de las dos listas son pares de números que indican una determinada celda, y necesito que no aparezca dos veces la misma celda.

Aqui tienes el codigo:


Const MAX = 10
Option Base 1


Sub p()
Cells.Clear
Dim columnas As New Collection
Dim celdas(10) As Variant
Dim unicos As Dictionary


'Rellenamos la colleccion para las columnas, las cuales estan asociadas
'por clave valor, para la columna A se le asigna 1, para la B se le
'asigna 2, etc...
For i = 65 To 74
columnas.Add Chr(i) 'de A - J (columnas)
Next i


conta = 1


'Generar las 10 celdas para asignarles 10
While conta <= 10
fila = Application.WorksheetFunction.RandBetween(1, MAX) 'aleatorio entre 1-10
columna = Application.WorksheetFunction.RandBetween(1, MAX) 'aleatorio entre 1-10
celda = columnas.Item(columna) & fila 'se arma la llave
If Not duplicado(celda, celdas) Then 'se busca dentro de la matriz
celdas(conta) = celda 'en caso de no encontrarla, se agrega
conta = conta + 1 ' se incrementa el contador
End If
Wend


For i = 1 To 10
Range(celdas(i)) = 10 'se rellenan las celdas generadas
Next i
End Sub


'Busca duplicados en una matriz
Function duplicado(llave, matriz)
For i = 1 To 10
If matriz(i) = llave Then
duplicado = True
Exit Function
End If
Next i


duplicado = False
End Function
[/CODE]

Todo un despapaye para buscar duplicados... si lo hubiera echo en Python, hubiese utilizado la mitad de lineas al valerme de un diccionario para los valores unicos, trate de emplear un colección y agregar un controlador de errores al intentar introducir un duplicado, la primera vez funcionaba pero en las posteriores iteraciones fallaba.

Aqui esta otro ejemplo usando la referencia Microsoft Scripting Runtime para poder utilizar el objeto dictionary:

[CODE]
Sub celdas_unicas()
Dim columnas As New Dictionary
Dim unicos As New Dictionary


Cells.Clear


'Rellenamos el diccionario para las columnas, las cuales estan asociadas
'por clave valor, para la columna A se le asigna 1, para la B se le
'asigna 2, etc...
For i = 65 To 74
columnas.Add (i - 64), Chr(i)
Next i


conta = 1


'Generar las 10 celdas para asignarles 10
While conta <= 10
fila = Application.WorksheetFunction.RandBetween(1, MAX) 'aleatorio entre 1-10
columna = Application.WorksheetFunction.RandBetween(1, MAX) 'aleatorio entre 1-10
celda = columnas.Item(columna) & fila 'se arma la llave

If Not unicos.Exists(celda) Then 'validar si la celda esta duplicada en el diccionario
unicos.Add celda, celda
conta = conta + 1 ' se incrementa el contador
End If
Wend


For Each i In unicos.Keys
Range(i) = 10
Next i
End Sub


[/CODE]

Como veras se redujo considerablemente el numero de lineas.

Nota: Los codigos anteriores solo funcionan para Excel 2007 ya que utilizo:

Application.WorksheetFunction.RandBetween

la cual solo funciona para el 2007

Link to comment
Share on other sites

Hola a todos:

Con tu permiso DigitalBoy, creo que es algo mas sencillo:



Sub DiezCeldasValor10()
Dim Celda(77) As Boolean
Range("B2:H12").Cells.ClearContents
Randomize
Do Until celdas = 10
n = Int((77 * Rnd) + 1)
If Celda(n) = False Then
Celda(n) = True
celdas = celdas + 1
y = n Mod 7 + 2
x = (n - y + 2) / 7 + 1
Cells(x, y) = 10
End If
Loop
End Sub


[/CODE]

Saludos

Link to comment
Share on other sites

Guest Cacho R

A lo mejor la siguiente opción es -también- útil:

Sub DiezCeldasConValor10enB2H11()
Randomize
With [b2:h11]
.ClearContents
Do
.Cells(WorksheetFunction.Min(70, 1 + 70 * Rnd)) = 10
Loop Until WorksheetFunction.Sum(.Cells) = 100
End With
End Sub[/PHP]

Saludos para todos.

Cacho R.

[u]P.D.[/u]

Y, ya que estamos, agrego la versión minimalista de lo anterior con 5 líneas de programa:

[PHP]Sub DiezCeldasConValor10enB2H11versiónReducida()
Randomize
[b2:h11].ClearContents
Do
[b2:h11].Cells(WorksheetFunction.Min(70, 1 + 70 * Rnd)) = 10
Loop Until WorksheetFunction.Sum([b2:h11]) = 100
End Sub[/PHP]

Link to comment
Share on other sites

Lo he probado con la última opción de Cacho R y me ha funcionado, al menos por ahora no se ha repetido ninguna celda. Si puedo más adelante probaré las demás opciones, a ver si funcionan igual de bien. Muchas gracias a todos!

Link to comment
Share on other sites

Lo he probado con la última opción de Cacho R y me ha funcionado, al menos por ahora no se ha repetido ninguna celda.

Ni se repetirán! No a simple vista... por que en si, los valores pueden sobrescribirse pero una vez que la suma sea 100 se saldrá del Do Loop.

Sin duda las soluciones de Cacho y M.Antonio fueron muy simples y practicas sobre todo la de cacho. Buenos aportes!

Link to comment
Share on other sites

Guest Cacho R

Y, si en lugar de tener que obtener "10 veces 10" hubiese que obtener "10 valores cualesquiera", la modificación al código básico es poco significativa...

Saludos para todos.

Cacho.

Link to comment
Share on other sites

Archived

This topic is now archived and is closed to further replies.

×
×
  • Create New...

Important Information

Privacy Policy