Buccle para recorrer filas, asignar fórmulas y formatos según tamaño de un archivo.
Para Elsa Matilde:
Estimada, requiero un soporte para implementar un buccle en la parte del código VBA que me diste soporte.
- Sucede que tengo las fórmulas contara para 5 códigos y pueden ser más.
- Las series repetidas que se pintan de amarillo solo están para la primera columna de K3 hacia abajo, se debe adecuar al tamaño que tenga archivo.
- Los códigos de la columna C2 en la muestra están solo transpuestos para 5, pero pueden variar de 5 a más.
- En K1 esta el formato que si es igual a F2 pinta verde, caso contrario rojo. Las demás columnas deben ser igual. Ejemplo, L1 para F3, M1 para F4 y así sucesivamente.
- Los With si también pueden ir en un buccle.
Estoy adjuntando el libro a tu correo.
1 respuesta
Respuesta de Elsa Matilde
1
Te dejo aquí la macro que solicitas. La fui separando por tareas para tu mejor comprensión.
Sub Transponer()
'x Elsamatilde
Application.ScreenUpdating = False
'se borran posibles formatos anteriores
Cells.FormatConditions.Delete
'se transpone el total de la col C a la fila 2 a partir de K
filx = Range("C" & Rows.Count).End(xlUp).Row
Range("C2:C" & filx).Copy
Range("K2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("K1").Select
Application.CutCopyMode = False
'Formulas CONTARA. rango absoluto. Ajustar a un nro razonable de filas en lugar de 10.000
[K1].FormulaR1C1 = "=COUNTA(R3C:R10000C)"
Range("K1").AutoFill Destination:=Range("K1:O1"), Type:=xlFillDefault
'Fto.condicional a partir de fila 3 hasta todas las filas posibles (*)
Range("K3:K10000").Select
Range("K3").Activate
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=CONTAR.SI(K$3:K3;K3)>1"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
'se copia el fto condicional al resto de las col
y = Range("IV2").End(xlToLeft).Column
For x = 12 To y
Range("K3:K100000").Copy
Cells(3, x).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Next x
'contenido y formato a J1
[J1] = "Contador de Series"
With [J1]
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.ReadingOrder = xlContext
End With
With [J1].Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With [J1].Font
.Bold = True
.Name = "Franklin Gothic Demi Cond"
.Size = 14
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'formato a celdas de fila 1 a partir de K
Range(Cells(1, 11), Cells(1, y)).Select
With Selection.Font
.Name = "Franklin Gothic Demi Cond"
.Size = 22
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
End With
'Formato condicional en fila 1 a partir de K
x = 2 '1° fila en col F
For i = 11 To y
Cells(1, i).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=$F$" & x
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="=$F$" & x
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
x = x + 1
Next i
'ajustar ancho a las col ocupadas para q se vean bien los nros de serie (**)
Range("K1:" & Cells(1, y).Address).ColumnWidth = 13
End Sub
'(*) Ajustar la fila final hasta donde consideres apropiado.
'(**) Luego de ingresar alguna serie escaneada comprobar cuál es el ancho adecuado
'y colocar ese valor en la instrucciónSdos y no olvides valorar la respuesta para darla por cerrada.
Elsa
*Cyber-mes en manuales Excel.
