Código VBA para una macro que reemplace, y borrar
Tengo una macro por terminar quisiera que me ayuden en unos pasos que los detallo:
Tengo el siguiente archivo:
Paso A:
En este caso mis datos tienen 303 registros, explico lo que se hace de forma manual para que me puedan ayudar en un código de macro:
-Selecciono los datos de FECHA, CLIENTE, DESTINO, menos el Gran Total del final del archivo, una vez seleccionados corto y pego a la segunda fila vacía, en este caso a partir de E2:H2. Luego hago lo mismo con la columna TEXTO, corto y pego sin incluir el Gran total y lo pego a partir de M2. En este caso el archivo tiene 303 registros pero pueden ser 40 o 100, es decir es variable, el código de VBA debería validar eso.
Paso B:
Selecciono COLUMNA "OC", desde E2 hacia el final del registro sin incluir el Gran Total, lo que tengo que hacer es eliminar la palabra Total de la OC que se encuentran resaltadas.
Debe quedar asi:
PASO C:
Filtro la Columna Código y desactivo las vacías
Luego de desactivar las vacías me queda el cuadro como en la foto lo que hago es borrar los registros FECHA - CLIENTE DESTINO - TEXTO, en este caso el primer registro empieza en F15 pero puede empezar en F2 lo mismo en texto puede empezar en M2
Una vez borrados me voy a la columna A en "ID", a partir de A2 hacia el final del archivo sin incluir el Gran Total debe ir la letra "D" mayúsculas en rojo.
PASO D: Que es el ultimo, filtro la columna código y esta vez activo solo las vacías.
Van a quedar OC que están resaltadas y en las nombres a partir de A1:D1, es decir "ID-ORG-CANAL-SECTOR" Se deben llenar con los datos:
ID: va la letra "H" mayúsculas Azul.
ORG: va "PECO"
CANAL: "20"
SECTOR:"TV"
Quedando como en las fotos, llenar en ID con la letra H y en ORG canal y sector como el cuadrito de las foto llenar hacia el final del archivo sin incluir el Gran Total.
Hay días que puedo tener un archivo con 50 OC a más.
Espero puedan ayudarme con un Código VBA para poder terminar mi macro.
Gracias de antemano.
Slds.
Juan A.
1 respuesta
Si todos estos pasos que nos detallas aquí los hubieses hecho con la grabadora de macros encendida ya tendrías la macro y a nosotros nos quedaría pulirla un poco para adaptarla a cualquier situación.
Por lo tanto para no tener que enviarnos tu libro hacé esto:
- Encendé la grabadora desde el menú de Macros.
- Realizá todos los pasos en el orden que necesites.
- Detené la grabadora de macros.
- Entrá al Editor y en un módulo encontrarás el código.
Dejamelo escrito aquí o enviámelo a alguno de mis correos para ajustarlo.
Estimada Elsa:
Te adjunto la grabadora de macro que me hace todo este proceso:
El tema es como dices adaptarla a cualquier situación. Debido a que, esta hecha con 303 registros, allí corre bien, pero cuando tengo ordenes más pequeñas digamos 50 pedidos, me quedan muchísimas filas en blanco
Te adjunto código de la macro que hice para estos pasos que detalle líneas arriba.
'cortar y reemplazar cuarto y quinto paso del wins...
Range("F3:H303").Select
Selection.Cut
Range("F2").Select
ActiveSheet.Paste
Range("M3:M303").Select
Selection.Cut
Range("M2").Select
ActiveSheet.Paste
Range("E2:E303").Select
Selection.Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$T$303").AutoFilter Field:=9, Criteria1:="<>"
Range("E3:H303").Select
Selection.ClearContents
Range("M3:M303").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-6
Range("A3").Select
ActiveCell.FormulaR1C1 = "D"
Range("A3:A303").Select
Selection.FillDown
Selection.Font.Bold = True
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Range("I1").Select
Selection.AutoFilter
Selection.AutoFilter
ActiveSheet.Range("$A$1:$T$303").AutoFilter Field:=9, Criteria1:="="
Range("A2").Select
ActiveCell.FormulaR1C1 = "H"
Range("B2").Select
ActiveCell.FormulaR1C1 = "PECO"
Range("C2").Select
ActiveCell.FormulaR1C1 = "20"
Range("D2").Select
ActiveCell.FormulaR1C1 = "TV"
Range("A2:A302").Select
Selection.FillDown
Selection.Font.Bold = True
With Selection.Font
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.399975585192419
End With
Range("B2:D302").Select
Selection.FillDown
Selection.Font.Bold = True
Range("B1").Select
Selection.AutoFilter
End Sub
Aquí va comentada para que puedas ajustar otros detalles si los necesitas.
Sub macroJuan()
'ajustada y comentada x Elsamatilde
'coloco el fin de rango en variable xq lo necesitaré en varias línes y me evito volver a escribirlo
filx = Range("F" & Rows.Count).End(xlUp).Row
'subir los rangos
Range("F3:H" & filx).Cut
Range("F2").Select
ActiveSheet.Paste
Range("M3:M" & filx).Cut
Range("M2").Select
ActiveSheet.Paste
'reemplazo de Total
Range("E2:E" & filx).Select
Selection.Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'filtrado por 'no vacíos' en col I
Range("A2").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$T$" & filx).AutoFilter Field:=9, Criteria1:="<>"
'limpieza de rangos
Range("E3:H" & filx).ClearContents
Range("M3:M" & filx).ClearContents
'coloca letra en col A con formto
Range("A3").FormulaR1C1 = "D"
Range("A3:A" & filx).Select
Selection.FillDown
Selection.Font.Bold = True
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
'filtrado de vacios en col I
Range("I1").Select
Selection.AutoFilter
Selection.AutoFilter
ActiveSheet.Range("$A$1:$T$" & filx).AutoFilter Field:=9, Criteria1:="="
'coloca valores en celdas ... otra sintaxis posible
[A2] = "H"
[B2] = "PECO"
[C2] = "20"
[D2] = "TV"
'relleno con formato--- ahora hay 1 fila menos
Range("A2:A" & filx - 1).Select
Selection.FillDown
Selection.Font.Bold = True
With Selection.Font
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.399975585192419
End With
Range("B2:D" & filx - 1).Select
Selection.FillDown
Selection.Font.Bold = True
Range("B1").Select
Selection.AutoFilter
End SubSdos!
