Como deixar minha macro mais rápida?

[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

 

 

[Alyson Ronnan Martins]

Boa noite @Leonardo Renner

Com eu não tenho como testar o exemplo que esta mostrando tenta usar o seguinte código:

Application.Calculation = xlCalculationManual 

Olha se vai melhorar o tempo de processamento, depois só mudar para automático.