Excel Macro Realizar tabla con una Combinación de letras

Espero Te Encuentres Bien, podrás ayudarme por favor

Debo realizar una macro pero la verdad no se por donde empezar..

El Ejemplo es el Siguiente..: QUE EN UNA TABLA SE HAGA UNA COMBINACIÓN DE CIERTAS LETRAS

En la Columna de A, esta "VL", nunca podrá haber dos letras en una misma celda..

No se si sea complicado... La verdad no se como empezar y mi problema es con 14 columnas... Aquí solo mostré 3 columnas...

1 Respuesta

Respuesta
2

Te anexo la macro. Funciona de acuerdo a tu ejemplo.

Antes de ejecutar la macro debes considerar lo siguiente:

- Funciona para celdas que tienen 2 letras ejemplo: "VL" o una letra ejemplo: "V". No funciona para celdas que tengan más de 2 letras.

- Deberás ordenar las columnas, primero las que tienen 2 letras y después las que tienes 1 letra

- El resultado será las combinaciones que necesitas, posteriormente podrás ordenar las columnas como requieres.

- Deberás poner las letras en la fila 1 empezando en la columna A

- El resultado quedará iniciando en la fila

- En las filas 2,3 y 4 estoy agregando una serie de cálculos necesarios para la macro

Ejemplo:

Como puedes apreciar en la imagen, primero puse las columnas que tienen 2 letras y después las que tiene una letra. Después de la macro puedes acomodarlas como desees, el resultado es el mismo.


Sub Combi_2()
'
'Por.Dante Amor
    '
    Dim letras As New Collection
    '
    Rows("2:" & Rows.Count).Clear
    uc = Cells(1, Columns.Count).End(xlToLeft).Column
    With Range("A2", Cells(2, uc))
        .FormulaR1C1 = "=LEN(R[-1]C)"
    End With
    wmult = 1
    For i = 1 To uc
        wmult = wmult * Cells(2, i)
    Next
    Range("A3") = wmult
    With Range("B3", Cells(3, uc))
        .FormulaR1C1 = "=IF(R[-1]C=1,R3C1,RC[-1]/R[-1]C)"
    End With
    With Range("A4", Cells(4, uc))
        .FormulaR1C1 = "=R[-1]C/R[-2]C"
    End With
    '
    wlim = Range("A3")
    For j = 1 To uc
        n = 0
        m = 2
        i = 6
        Set letras = Nothing
        For k = 1 To Len(Cells(1, j))
            letras.Add Mid(Cells(1, j), k, 1)
        Next
        '
        Do While n < wlim
            If m = 2 Then m = 1 Else m = 2
            For ii = 1 To Cells(4, j)
                Cells(i, j) = letras(m)
                i = i + 1
                n = n + 1
            Next
        Loop
    Next
    MsgBox "Fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas