Notifications
Clear all

Código da Macro lento

9 Posts
3 Usuários
0 Reactions
1,205 Visualizações
(@luizhcosta)
Posts: 420
Honorable Member
Topic starter
 

Bom dia,

Gostaria de saber como agilizar o processamento de uma macro. Ocorre que isoladamente, em outra planilha, a macro funciona agilmente, porém quando a macro está em outra pasta juntamente com outras macros, esta demora para processar.
Tem alguma configuração que possa agilizar esse procedimento?

 
Postado : 22/03/2016 7:45 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Hà muitas coisas que pode ser feitas para agilizar um código.
Para sabermos qual sugerir, precisamos ver o código, e todas as macros que podem estar concorrendo...

Por favor coloque um exemplo do arquivo lento...

Abs

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 22/03/2016 8:01 am
(@luizhcosta)
Posts: 420
Honorable Member
Topic starter
 

Olá Fernando,

Curiosamente o código é seu. Foi uma outra dúvida que você mandou o código. Inicialmente não estava funcionando porque, a coluna onde a macro utilizava para nomear os arquivos devia ter algum caractere que travava o código. Então o Reinaldo alterou e resolveu o caso. Se executado isoladamente, funciona rapidamente. Acontece que ele foi inserido em outra planilha, aí é uma lentidão para importar os *.txts.

Sub AleVBA_19511()
Dim rCell As Range
Dim FF As Long, Counter As Long
Counter = 1
    For Each rCell In Range("A1", Range("A" & Rows.Count).End(xlUp))
        If rCell.Value <> "" And Range("A" & rCell.Row).Value <> "" Then
            FF = FreeFile()
            '                Aqui o arquivo pega o nome das células col A
            Open ThisWorkbook.Path & "" & Counter & ".txt" For Output As #FF
            Print #FF, rCell.Text
            Close #FF
            Counter = Counter + 1
        End If
    Next rCell
    
    MsgBox Counter & " Arquivos salvos. ", , "Criar Arquivo de Texto"
    
End Sub

.

Pode verificar ?.

Obrigado.

 
Postado : 22/03/2016 10:23 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Oi Luiz, vou dar uma olhadinha, mas já adianto: esse código não é meu não.
Eu percebo pela padronização de declaração de variáveis, uso dos objetos e tal.
Posso até eventualmente ter mexido no código do AleVBA *(que nomeia seus códigos com o nome dele), mas esse código claramente não foi escrito por mim não.

Sub AleVBA_19511_EditadoPorFernandoFernandes()
Dim Pasta   As String
Dim Matriz  As Variant
Dim FF      As Long
Dim Counter As Long
    
    Pasta = ThisWorkbook.Path
    Matriz = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
    For Counter = LBound(Matriz, 1) To UBound(Matriz, 1)
        If Matriz(Counter, 1) <> vbNullString Then
            FF = FreeFile()
'Aqui o arquivo pega o nome das células col A
            Open Pasta & "" & Counter & ".txt" For Output As #FF
            Print #FF, VBA.CStr(Matriz(Counter, 1))
            Close #FF
            Counter = Counter + 1
        End If
        
    Next Counter
    
    MsgBox Counter & " Arquivos salvos. ", , "Criar Arquivo de Texto"
    
End Sub

Isso que eu fiz, acredito que vai melhorar muito o desempenho.
Dá uma conferida, trabalhei com matrizes.

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 22/03/2016 10:38 am
(@luizhcosta)
Posts: 420
Honorable Member
Topic starter
 

Olá Fernando,

Cara, mil desculpas. Eu fiz uma confusão aqui. Sem desmerecer nem um nem outro. Realmente o código foi postado pelo Axeandre VBA.
Vou fazer uns testes e retorno.

Valeu.

 
Postado : 22/03/2016 1:04 pm
(@luizhcosta)
Posts: 420
Honorable Member
Topic starter
 

Fernando,

Já arrumei aqui as informações. Seguinte, o código é seu. Não o código que postei, mas outro código que não foi postado.
O código para a ajuda neste tópico é o seguinte;

Public Sub ImportarArqText)

    Dim NomeArquivo As String
    Dim Caminho As String
        
    Dim wshContratos As Worksheet
    Dim rngCell As Range
    Dim rngMyArquivos As Range
    Dim celDestino
    
    'definimos o nome da aba
    Set wshContratos = Worksheets("Contratos")
    
    'Definimos o Range com Dados até a ultima linha preenchida
    Set rngMyArquivos = wshContratos.Range("c2:c" & Range("c" & Rows.Count).End(xlUp).Row)
       
    'Definimos o caminho no mesmo local do arquivo Controle.xls
    Caminho = ActiveWorkbook.Path & ""
    
    'Loop em cada celula no Range
    For Each rngCell In rngMyArquivos
        
        'Definimos a celula para inserir o texto
        celDestino = rngCell.Offset(0, 2).Address(0, 0)
        
        'Nome de cada arquivo
        NomeArquivo = rngCell & ".txt"

        If VBA.CreateObject("Scripting.FileSystemObject").FileExists(Caminho & NomeArquivo) Then

             
        'Abre o arquivo para leitura
            Open Caminho & NomeArquivo For Input As #1
            
            'Inseri o conteudo do arquivo na celula correspondente ao arquivo
            Range(celDestino).Value = Input$(LOF(1), 1)
            
            'Fecha o arquivo Texto
            Close #1
        Else
            Msgbox "Arquivo não Encontrado"
        End If            
    Next rngCell
        
    ActiveSheet.Range("A:O").Columns.AutoFit
       
End Sub

.

Houve sim uma pequena adaptação como falei por outro colega, Trindade.

A falha continua sendo minha, e peço desculpas pela bagunça.

 
Postado : 22/03/2016 1:23 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Parece que falta um parentese na primeira linha?
Pelo que vejo no código, minha única contribuição foi esse linha:

If VBA.CreateObject("Scripting.FileSystemObject").FileExists(Caminho & NomeArquivo) Then

é a única que parece ter sido eu que escrevi ...
E pelo que li, o objetivo é ler um txt e colocar seu conteúdo na célula duas colunas ao lado...
isso vou demorar um pouco mais pra fazer...

Vai ter que esperar...

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 22/03/2016 1:27 pm
(@luizhcosta)
Posts: 420
Honorable Member
Topic starter
 

Olá Fernando,

Ainda estou contando com a sua ajuda no código. Para não haver dúvidas, estou postando o código que utilizo atualmente. A questão é que, o conteúdo importado é base de pesquisa para algumas fórmulas, imagino que durante o cálculo, a macro leve mais tempo para processar. Então a idéia é isolar a macro até sua conclusão. Nem sei se isso é possível. Em todo caso, estou no aguardo.

Public Sub Importar()

    Dim NomeArquivo As String
    Dim Caminho As String
        
    Dim wshContratos As Worksheet
    Dim rngCell As Range
    Dim rngMyArquivos As Range
    Dim celDestino
    
      
    'definimos o nome da aba
    Set wshContratos = Worksheets("Contratos")
    
    'Definimos o Range com Dados até a ultima linha preenchida
    Set rngMyArquivos = wshContratos.Range("c2:c" & Range("c" & Rows.Count).End(xlUp).Row)
       
    'Definimos o caminho no mesmo local do arquivo Controle.xls
    Caminho = ActiveWorkbook.Path & ""
    
    'Loop em cada celula no Range
    For Each rngCell In rngMyArquivos
        
        'Definimos a celula para inserir o texto
        celDestino = rngCell.Offset(0, 1).Address(0, 0)
        
        'Nome de cada arquivo
        NomeArquivo = rngCell & ".txt"

        If VBA.CreateObject("Scripting.FileSystemObject").FileExists(Caminho & NomeArquivo) Then

             
        'Abre o arquivo para leitura
            Open Caminho & NomeArquivo For Input As #1
         
            'Inseri o conteudo do arquivo na celula correspondente ao arquivo
            Range(celDestino).Value = Input$(LOF(1), 1)
         
            'Fecha o arquivo Texto
            Close #1
        Else
            MsgBox "Arquivo não Encontrado  " _
            & rngCell
        End If
    Next rngCell
        
    ActiveSheet.Range("A:O").Columns.AutoFit
MsgBox "Importação Concluída !!!"
End Sub




Obrigado.

 
Postado : 11/04/2016 12:35 pm
(@mprudencio)
Posts: 2749
Famed Member
 

Coloque a planilha em codigo manual no incio do codigo e mude para automatico no final.

Talvez resolva.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 11/04/2016 12:45 pm