Vou começar pelo começo.
1) Verifiquei com teclando Ctrl+End que seu arquivo de 5,3MB enxergava cerca de 65mil linhas. Já conhecendo o problema, fui até a ultima realmente preenchida, em torno da linha 18mil, e selecionei todas as linhas abaixo e as excluí. Ao salvar, seu novo arquivo ficou com 2,4MB.
2) Verifiquei que a extensão do seu arquivo é XLS, que é do Excel antigo (2003) para trás.. Isso faz o arquivo ser naturalmente enorme. As extensões XLSX e XLSM são por natureza compactadas, então eu salvei como XLSM (pq tem macro) e o tamanho caiu de 2,4MB para 1,2MB.
3) Agora fui mexer no seu código, aplicando uma ideia completamente nova, aproveitando de matrizes para acumular os intervalos a serem excluídos, e excluí-los somente ao final do processo, todos de uma vez. Acredito inclusive que esse approach pode melhorar o desempenho.
4) Testei aqui e funcionou perfeitamente. Dá uma olhada.
5) Este é o código:
Option Explicit
'Fernando Fernandes
'fernando.fernandes@outlook.com.br
Public Sub EliminarZeros()
Dim Planilha As Excel.Worksheet
Dim rngApagar As Excel.Range
Dim arrColunaK As Variant
Dim cnt As Long
Dim UltimaLinha As Long
Set Planilha = Worksheets("Book")
With Planilha
If .AutoFilterMode Then .AutoFilter.ShowAllData
UltimaLinha = .Cells(.Rows.Count, 11).End(xlUp).Row
arrColunaK = .Range("K1:K" & UltimaLinha).Value
'acumulando todas as linhas com 0 num único range
For cnt = 9 To UBound(arrColunaK, 1)
If VBA.IsNumeric(arrColunaK(cnt, 1)) Then arrColunaK(cnt, 1) = arrColunaK(cnt, 1) * 1
If arrColunaK(cnt, 1) = 0 Then
If rngApagar Is Nothing Then
Set rngApagar = .Rows(cnt)
Else
Set rngApagar = Application.Union(rngApagar, .Rows(cnt))
End If
End If
Next cnt
'se houve linhas com zero, essas linhas serão apagadas aqui, de uma só vez.
If Not rngApagar Is Nothing Then
rngApagar.EntireRow.Delete Shift:=xlUp
End If
End With
'limpando a memória
Set rngApagar = Nothing
Set Planilha = Nothing
End Sub
6) Este é o anexo, compactado, ainda com os zeros, para você testar.
Qquer coisa dá um grito, Joana!
FF
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 06/02/2015 10:43 am