Problema con codigo macro

Héctor Miguel escribió:

hola, Mk !

... macros que... elimina todas las filas que tengan las celdas en blanco de una determinada columna (E)
[F:F].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
... parece que en realidad "no borra" las filas ya que al visualizar la matriz resultante parece que quedan ocultas.

nota que la instruccion -> .EntireRow.Delete NO oculta... ELIMINA las filas 'indicadas' ;)
tienes registros 'filtrados' en el rango donde aplicas la macro ?

comentas [si hubiera] detalles adicionales ?
saludos,
hector.

Hola HM!

Como siempre, gracias por responder.

Creo que el error está efectivamente en el filtrado pero tengo que
realizarlo por narices puesto que uno de los procesos de la macro es que
elimine las filas de la matriz que tengan determinado valor en la columna E.

Para ser mas exacto, todas las celdas de la columna E que tengan valor
0, 2 ó 3 quiero que sean eliminadas junto con su fila. El código que
tengo para esta acción es el siguiente:

' Ahora trato de filtrar mas rapido y sin falloS
' Defino las variables

Dim Rng As Range
Dim I As Long
Dim myArr As Variant

myArr = Array("0", "2", "3")
For I = LBound(myArr) To UBound(myArr)

ActiveSheet.Range("E1:E10000").AutoFilter Field:=5,
Criteria1:=myArr(I)
With ActiveSheet.AutoFilter.Range
Set Rng = Nothing
On Error Resume Next
Set Rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not Rng Is Nothing Then Rng.EntireRow.Delete
End With
Next I
ActiveSheet.AutoFilterMode = False


' Ya he realizado el filtrado y solo tengo los articulos de MV1
' Elimino la columna E ya que no me hace falta

[E:E].EntireColumn.Delete


Para el resto de celdas de la columna E que estén en blanco las elimino
simplemente con la instrucción del princio, ¿alguna idea?.

Saludos!

hola, Mk !

... macros que... elimina todas las filas que tengan las celdas en blanco de una determinada columna (E)
[F:F].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
... parece que en realidad "no borra" las filas ya que al visualizar la matriz resultante parece que quedan ocultas.

nota que la instruccion -> .EntireRow.Delete NO oculta... ELIMINA las filas 'indicadas' ;)
tienes registros 'filtrados' en el rango donde aplicas la macro ?

comentas [si hubiera] detalles adicionales ?
saludos,
hector.

Hola HM!, he probado tu código y funciona muy bien aunque sigo teniendo
el problema de la eliminación de las filas.

Te pego el código entero de la macro. Mis conocimientos de vb son muy
limitados y la macro es una mezcla de código que recopilé de paginas
web, grabadora de macros, etc...así que si observas alguna "burrada" no
te asustes. ;-D

En fín, ahí va..




Sub K22_Mejorado()

' Comienzo abriendo el fichero del que voy a obtener los datos

Workbooks.Open Filename:="F:\EXCELL\Gadd_Report1.xls"

' Elimino la hoja Info para que no me toque los guevos

Application.DisplayAlerts = False
Sheets("Info").Delete
Application.DisplayAlerts = True

' Elimino columnas que no necesito

Range("B:B,C:C,G:G,H:H,I:I,K:K,L:L,M:M").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select

' Ahora trato de filtrar mas rapido y sin falloS

'>> NUEVO <<-

Dim myArr As Variant, I As Byte: myArr = Array(0, 2, 3)
With ActiveSheet
For I = LBound(myArr) To UBound(myArr)
.Range("e1").AutoFilter Field:=5, Criteria1:="=" & myArr(I)
With .AutoFilter.Range
With .Offset(1).Resize(.Rows.Count -
1).SpecialCells(xlCellTypeVisible)
If .Rows.Count Then .EntireRow.Delete
End With: End With: Next: .AutoFilterMode = False: End With

'<< - HASTA AQUI

' Ya he realizado el filtrado y solo tengo los articulos de MV1

' Elimino la columna E ya que no me hace falta

[E:E].EntireColumn.Delete

'Añadimos la formula para vincular

Range("E1").Select
ActiveCell.FormulaR1C1 = "LV"

'Formula

Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],[LV.xls]AL010!C2:C4,3,0)"
Range("E2").Copy Range(Range("e2"),
Range("D65536").End(xlUp).Offset(, 1))

'Doy formato

Columns("E:E").Select
Selection.NumberFormat = "00 00 00"
Selection.Font.Bold = True

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Range("C2").Select
Range(Range("A1"), Range("E65536").End(xlUp).Offset(, 1)).Sort
Key1:=Range("E2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Select

Range("a2").CurrentRegion.Select

' Ahora va toda la basura del formato
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Columns("D:D").Select
With Selection
.HorizontalAlignment = xlCenter
End With

Range("A2").Select

' Mas formato

Rows("1:1").Select
Selection.Font.Bold = True
Cells.EntireColumn.AutoFit

' Filtro los consignement o camiones y pego los valores en la columna J

Columns("A:A").AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:=Columns( _
"A:A"), CopyToRange:=Range("J1"), Unique:=True
Columns("J:J").Select
Range("A2").Select

Rem Añado formula para tener siempre un rango fijo de 32 camiones

Range("K1").Select
ActiveCell.FormulaR1C1 = "=Extract"
Range("K2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",""Sin datos"",RC[-1])"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K33"), Type:=xlFillDefault
Range("K2:K33").Select
Columns("J:L").Select
Selection.EntireColumn.Hidden = True
Range("A2").Select

Rem cargo el formulario de filtrado

Load Form_Filtrado_K22
Form_Filtrado_K22.Show

' Trato de contar el número de pallets

'Range("E2").Select
'While ActiveCell.Value <> ""
'ActiveCell.Offset(1, 0).Range("A1").Select
'Wend
'ActiveCell.Offset(-1, 1).Select

' Modifico la hoja para que entre en una sola hoja

With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.590551181102362)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed

End With

'Doy los toques finales

Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.RowHeight = 21

Range("A1:B1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Selection.Merge
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Range("C1:E1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A1:B1").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("C1:E1").Select
ActiveCell.FormulaR1C1 = "LISTADO DE ARTICULOS CAMION -K22- DE
METODO VENTA 1"
Rows("1:1").Select
Selection.Font.Bold = True
With Selection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
End With

'Inserto columna para saber el número de pallets

'Columns("A:A").Select
'Range("A2").Activate
'Selection.Insert Shift:=xlToRight
'Columns("A:A").Select
'Selection.ColumnWidth = 4.29

'Range("A2").Select
'ActiveCell.FormulaR1C1 = "=R[-1]C+1"
'Range("a2").Copy Range(Range("a2"),
Range("b65536").End(xlUp).Offset(, -1))
Range("a2").Select


End Sub

hola, Mk !

ya he realizado varias pruebas [con el codigo expuesto] y no he logrado 'reproducir' la falta de eliminacion de las filas :-((
[quizas haya 'algo' que se esta 'pasando por alto'] -?-

lo que si te puedo 'sugerir' es 'agilizar' [un poquitin] el codigo y [puedes] evitar el 'manejo de errores' y la variable 'rango' ;)
prueba con lo siguiente:
=Sub Borrando(): Application.ScreenUpdating = False
Dim myArr As Variant, I As Byte: myArr = Array(0, 2, 3)
With ActiveSheet
For I = LBound(myArr) To UBound(myArr)
.Range("e1").AutoFilter Field:=5, Criteria1:="=" & myArr(I)
With .AutoFilter.Range
With .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
If .Rows.Count Then .EntireRow.Delete
End With: End With: Next: .AutoFilterMode = False: End With
End Sub

si cualquier duda [o encuentras algun 'detalle' adicional]... comentas ?
saludos,
hector.

Creo que el error esta efectivamente en el filtrado pero tengo que realizarlo por narices
puesto que uno de los procesos de la macro es que elimine las filas de la matriz que tengan determinado valor en la columna E.
Para ser mas exacto, todas las celdas de la columna E que tengan valor 0, 2 o 3 quiero que sean eliminadas junto con su fila.
El codigo que tengo para esta accion es el siguiente:
' Ahora trato de filtrar mas rapido y sin falloS
' Defino las variables
Dim Rng As Range
Dim I As Long
Dim myArr As Variant
myArr = Array("0", "2", "3")
For I = LBound(myArr) To UBound(myArr)
ActiveSheet.Range("E1:E10000").AutoFilter Field:=5, Criteria1:=myArr(I)
With ActiveSheet.AutoFilter.Range
Set Rng = Nothing
On Error Resume Next
Set Rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not Rng Is Nothing Then Rng.EntireRow.Delete
End With
Next I
ActiveSheet.AutoFilterMode = False
' Ya he realizado el filtrado y solo tengo los articulos de MV1
' Elimino la columna E ya que no me hace falta
[E:E].EntireColumn.Delete
Para el resto de celdas de la columna E que esten en blanco las elimino simplemente con la instruccion del princio

Buffff, casi que va a ser mas sencillo que cuelgue el fichero en el que
tengo la macro y por otra parte el fichero del que recoge los datos.

Creo que es abusar por mi parte pero ahora mismo me parece mucho mas
sencillo que tratar de explicartelo. Como te decía mis conocimientos son
limitados y hago lo que puedo ;D

Si tienes la paciencia y el humor suficiente puedes echarle un vistazo y
darme tu opinión o consejo para solucionarlo, o incluso cualquier
sugerencia para mejorarlo.

Muchas gracias.

Mk.

Nota; he preferido enviartelo por correo que colgarlo en las news, no me
parecía lo mas correcto ya que en realidad hay datos que prefiero no
publicar.