Leonardo Renner

Boa noite! Tenho uma macro que carrega o conteúdo de um arquivo .CSV para uma planilha do Excel e arruma (remove todos espaços) todas as linhas da coluna A. O problema é que quando o arquivo .CSV é muito grande, leva muito tempo para executar. Parte do código que arruma as células e gera lentidão: ' Função arrumar Dim rng As Range For Each rng In Selection If Len(rng) > 0 Then rng = Trim$(rng) End If Next rng Código completo: Sub Carregar_Local_Picking() ' Habilita o tratamento de erros On Error GoTo Trata_Erro ' Setar configurações de tela para executar a rotina With Application .ScreenUpdating = False .DisplayAlerts = False End With ' Desproteger planilha Sheets("LOCAL PICKING").Unprotect Password:="100*Aprovado" ' Mensagem ao usuário MsgBox "Selecione o arquivo de Locações de Picking do CD STD Parts mais recente (.CSV)!" & vbCrLf & vbCrLf & "Atenção: Este arquivo é o Relatório de Locações extraído do JDE no dia de hoje!" Dim fd As Office.FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .Filters.Clear .Title = "Selecione o arquivo de Locais SP" .Filters.Add "Relatório JDE", "*.csv", 1 .AllowMultiSelect = False .InitialView = msoFileDialogViewDetails .InitialFileName = ThisWorkbook.Path & "\" ' Ações condicionadas à seleção de um arquivo If .Show <> 0 Then ' Carregar arquivo Dim sFile As String sFile = .SelectedItems(1) ' Limpar aba Sheets("LOCAL PICKING").UsedRange.ClearContents ' Trazer mensagem para usuário na barra de status Application.StatusBar = "Aguarde. O arquivo está sendo carregado. Isso pode levar algum tempo." With Worksheets("LOCAL PICKING").QueryTables.Add(Connection:="TEXT;" & sFile, _ Destination:=Worksheets("LOCAL PICKING").Range("A1")) .RefreshStyle = xlOverwriteCells .TextFileStartRow = 4 .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .Refresh BackgroundQuery:=False End With ' Ativar planilha corrente Windows(ThisWorkbook.Name).Activate ' Ativar aba "LOCAL PICKING" da planilha corrente Sheets("LOCAL PICKING").Activate ' Contar número de linhas numeroRegistros = Sheets("LOCAL PICKING").Cells(Rows.Count, 1).End(xlUp).Row ' Selecionar intervalo de células ActiveSheet.Range("A1:A" & numeroRegistros).Select ' Função arrumar Dim rng As Range For Each rng In Selection If Len(rng) > 0 Then rng = Trim$(rng) End If Next rng ' Ativar aba "LISTA DE ROMANEIO" da planilha corrente Sheets("INSTRUÇÕES").Activate ' Proteger planilha Sheets("LOCAL PICKING").Protect Password:="100*Aprovado" ' Ocultar planilha Sheets("LOCAL PICKING").Visible = False ' Ocultar mensagem na barra de status Application.StatusBar = False ' Informar carregamento MsgBox "Arquivo de Locais de Picking carregado com sucesso!" ' Ativar aba "LISTA DE ROMANEIO" da planilha corrente Sheets("INSTRUÇÕES").Activate ' Informar status Range("E11").Formula = "=NOW()" ActiveSheet.Range("E11").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Else ' Informar não carregamento MsgBox "Não foi possível carregar o arquivo. Tente novamente!" End If End With Exit Sub ' Início da rotina de tratamento de erros Trata_Erro: MsgBox "Ocorreu um erro na execução do aplicativo. Por favor, tente novamente ou capture a tela e contate o programador." End Sub