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