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
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ón

Sdos y no olvides valorar la respuesta para darla por cerrada.

Elsa

*Cyber-mes en manuales Excel.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas