Crear pares de números no repetidos con random

[Nvidia]

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!

[Lázaro]

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.

[Nvidia]

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, = 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!

[digitalboy]

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

[Nvidia]

Muchas gracias, intentaré meterlo dentro de mi código a ver qué tal va!

[Antoni]

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

[Invitado 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]

[Nvidia]

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!

[digitalboy]

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!

[Invitado 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.