GENERAR COLUMNAS Y FILAS SIN NÚMEROS REPETIDOS UTILIZANDO VBA

Hola a todos!

Como en uno de mis últimos post comenté que programaría la misma rutina pero en VBA: GENERAR COLUMNAS Y FILAS SIN NÚMEROS REPETIDOS UTILIZANDO TYPESCRIPT

En este caso he realizado una pequeña modificación introduciendo un inputbox para indicar el número de filas y columnas, el resto del código sigue el mismo esquema que el realizado para typescript, es decir, tenemos un proceso automatizado que utiliza una función, buscaRep que se encarga que verificar que los números generados no están duplicados en la matriz que estamos generando:

El código utilizado es el siguiente:

Sub GenerarColumnasSinRepetir()
    Dim matriz() As Variant
    Dim numero As Long
    Dim fila As Long
    Dim columna As Long
    Dim repetido As Boolean
    Dim rango As Range
    Dim hoja As Worksheet
    Datos = InputBox("INDICA TOTAL DE FILAS Y TOTAL DE COLUMNAS SEPARANDO LO NÚMEROS POR UNA COMA:" & Chr(13) & Chr(13) & "EJEM: 10,10", "DIMENSIÓN")
    If Datos = Empty Then Exit Sub
    On Error GoTo etiqueta
    MisInput = Split(Datos, ",")
    'Redimensionamos la matriz
    ReDim matriz(1 To MisInput(0), 1 To MisInput(1))
    'Generamos numeros
    For fila = 1 To MisInput(0)
        For columna = 1 To MisInput(1)
            repetido = True
            ' Genera números hasta que encuentre uno no repetido
            Do Until repetido = False
            ' Genera un número aleatorio
                numero = Int((MisInput(0) * MisInput(1)) * Rnd) + 1
                'Verifica si el número ya está presente en la matriz
                If Not buscaRep(numero, matriz) Then
                    'El número no está repetido
                    repetido = False
                    'Almacena el número en la matriz
                    matriz(fila, columna) = numero
                End If
            Loop
        Next columna
    Next fila
    'Pasa los datos a la hoja activa
    Set hoja = ActiveSheet
    'Define el rango de destino
    Set rango = hoja.Range("A1").Resize(MisInput(0), MisInput(1))
    'Asignamos los valores de la matriz al rango
    rango.Value = matriz
    Exit Sub
etiqueta:
  MsgBox ("Verifica los datos que has introducido e inténtalo de nuevo"), vbExclamation
End Sub

Function buscaRep(ByVal number As Integer, ByRef arr() As Variant) As Boolean
    Dim element As Variant
    'Verificamos si el número es repetido
    For Each element In arr
        If element = number Then
            buscaRep = True
            Exit Function
        End If
    Next element
    buscaRep = False
End Function

El resultado es el siguente:

Y esto es todo!

Espero que sea de utilidad.

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.



¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies