Ir para conteúdo
Fórum Script Brasil
  • 0

VBA - Quando eu vou pelo F8 no meu código ele funciona, quando coloco no F5 ele trava fica não respondendo, poderiam me ajudar?

brunoramosd

Perguntado por brunoramosd,

 Share

Pergunta

brunoramosd

brunoramosd

Postado
Postado

Estou com um problema quando vou tentar executar meu código pelo F5 ele trava, porém quando eu rodo no F8 ele funciona.

O meu código ele é para fazer o seguinte:

Tabela 1: lista de CEPS tenho 1 inicial e 1 final 2 colunas (5.800 LINHAS)
Tabela 2: Outra tabela com mais CEPS 1 inicial e 1 final 2 colunas (33.204 LINHAS)

A ideia é identificar os CEPS faltantes na tabela 2 e montar uma nova tabela 3 com essas duas tabelas. Fiz o código abaixo:

---------------------------------------------------------
Sub Agrupa_CEPS()

Application.ScreenUpdating = False

Dim CEPINICIAL_BGGERAL
Dim CEPINIOLD_BGGERAL
Dim CEPFINAL_BGGERAL

Dim CEPINICIAL_BGSATURNO
Dim CEPFINAL_BGSATURNO
Dim CEPINICIALNEXT_BGSATURNO

'Copia Cabeçalho padrão Saturno
Sheets("Tabela Saturno").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Copy

Sheets("Tabela Agrupada").Select
Range("A1").PasteSpecial
Range("A1").Value = "Nome Base"
Range("A1").Select
Application.CutCopyMode = False

'Inicia varredura dos CEPS pela Saturno

Sheets("Base Geral").Select
Range("C2").Select

Sheets("Tabela Saturno").Select
Range("C2").Select

Do While ActiveCell <> ""

            CEPINICIAL_BGSATURNO = ActiveCell.Offset(0, 0).Value
            CEPINICIALNEXT_BGSATURNO = ActiveCell.Offset(1, 0).Value
            CEPFINAL_BGSATURNO = ActiveCell.Offset(0, 1).Value
            
             ActiveCell.EntireRow.Copy
                        
             Sheets("Tabela Agrupada").Select
             ActiveCell.Offset(1, 0).PasteSpecial
             Application.CutCopyMode = False
            
                
                Do While ActiveCell <> ""
                
                 Sheets("Base Geral").Select
            
                     CEPINICIAL_BGGERAL = ActiveCell.Offset(0, 0).Value
                     
                        If ActiveCell.Row = 2 Then
                           CEPINIOLD_BGGERAL = ActiveCell.Offset(0, 0).Value - 1
                        Else
                           CEPINIOLD_BGGERAL = ActiveCell.Offset(-1, 0).Value
                        End If
                    
                     CEPFINAL_BGGERAL = ActiveCell.Offset(0, 1).Value
                     

                    If CEPINICIAL_BGGERAL > CEPFINAL_BGSATURNO And CEPINIOLD_BGGERAL < CEPINICIAL_BGGERAL And CEPFINAL_BGGERAL < CEPINICIALNEXT_BGSATURNO Then
                    
                    
                        Sheets("Base Geral").Select
                        ActiveCell.EntireRow.Copy
                        
                        Sheets("Tabela Agrupada").Select
                        ActiveCell.Offset(1, 0).PasteSpecial
                        Application.CutCopyMode = False
                        
                        
                        End If
                    
                    Sheets("Base Geral").Select
                    ActiveCell.Offset(1, 0).Select
                    
                Loop
                
        Sheets("Base Geral").Select
        Range("C2").Select
                
        Sheets("Tabela Saturno").Select
        ActiveCell.Offset(1, 0).Select
Loop

Application.ScreenUpdating = True

MsgBox "Finalizado"


End Sub
---------------------------------------------------

Poderiam me ajudar por gentileza?

Obrigado

Link para o comentário
Compartilhar em outros sites

11 respostass a esta questão

Posts Recomendados

  • 0
Alyson Ronnan Martins

Alyson Ronnan Martins

Postado
Postado

Boa tarde @brunoramosd

Tenta para o calcula da planilha pare evitar os erros:
  

Application.Calculation = xlCalculationManual 'Para o calculo do excel
Application.Calculation = xlCalculationAutomatic 'No final do código quando terminar o processo coloca esse para o excel voltar a calular.

 

O motivo para ele estar "parando" deve ser por conta de várias "seleções" e copias que esta fazendo no processo do código.

Tenta mudar o código para não usar o "select" e sim o "cells" que você consegue no usando o loop "FOR".

Link para o comentário
Compartilhar em outros sites
  • 0
brunoramosd

brunoramosd

Postado
  • Autor
Postado
7 minutos atrás, Alyson Ronnan Martins disse:

Analisando o seu código vi que tem um while dentro de outro então gerou a duvida.

Base Geral

Tabela Agrupada

Qual das duas planilhas tem mais dados?

---------------------------------------------
 

A "Base Geral" é a maior com todas as tabelas fica em torno de 60 linhas, a "Tabela Saturno" fica na casa de 6k linhas e a "Tabela Agrupada" é a nova tabela criada com base na verificação.

A que tem mais dados é a planilha "Base Geral", ela tem uns 60k linhas e a "Tabela Saturno" uns 6k linhas e a "Tabela Agrupada" é a tabela final criada com a varredura da Tabela Saturno na Base Geral.

Link para o comentário
Compartilhar em outros sites
  • 0
Alyson Ronnan Martins

Alyson Ronnan Martins

Postado
Postado

Não compreendo a regra de negócio do sue código mais não seria melhor percorrer primeiro Geral e depois percorrer o Agrupado na comparação. 

Processo atual: 1 linha de Agrupado vai percorrer 60 mil linhas de Geral 
Processo proposto: 1 linha de geral vai verificar 6 mil linha de Saturno

Ou a maneira de compreender seu código está explicada de uma maneira muito simples e não entendi.

Você testou essa opção?
  

Sub Agrupa_CEPS()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'Para o calculo do excel


Dim CEPINICIAL_BGGERAL
Dim CEPINIOLD_BGGERAL
Dim CEPFINAL_BGGERAL

Dim CEPINICIAL_BGSATURNO
Dim CEPFINAL_BGSATURNO
Dim CEPINICIALNEXT_BGSATURNO

'Copia Cabeçalho padrão Saturno
Sheets("Tabela Saturno").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Copy

Sheets("Tabela Agrupada").Select
Range("A1").PasteSpecial
Range("A1").Value = "Nome Base"
Range("A1").Select
Application.CutCopyMode = False

'Inicia varredura dos CEPS pela Saturno

Sheets("Base Geral").Select
Range("C2").Select

Sheets("Tabela Saturno").Select
Range("C2").Select

Do While ActiveCell <> ""

            CEPINICIAL_BGSATURNO = ActiveCell.Offset(0, 0).Value
            CEPINICIALNEXT_BGSATURNO = ActiveCell.Offset(1, 0).Value
            CEPFINAL_BGSATURNO = ActiveCell.Offset(0, 1).Value
            
             ActiveCell.EntireRow.Copy
                        
             Sheets("Tabela Agrupada").Select
             ActiveCell.Offset(1, 0).PasteSpecial
             Application.CutCopyMode = False
            
                
                Do While ActiveCell <> ""
                
                 Sheets("Base Geral").Select
            
                     CEPINICIAL_BGGERAL = ActiveCell.Offset(0, 0).Value
                     
                        If ActiveCell.Row = 2 Then
                           CEPINIOLD_BGGERAL = ActiveCell.Offset(0, 0).Value - 1
                        Else
                           CEPINIOLD_BGGERAL = ActiveCell.Offset(-1, 0).Value
                        End If
                    
                     CEPFINAL_BGGERAL = ActiveCell.Offset(0, 1).Value
                     

                    If CEPINICIAL_BGGERAL > CEPFINAL_BGSATURNO And CEPINIOLD_BGGERAL < CEPINICIAL_BGGERAL And CEPFINAL_BGGERAL < CEPINICIALNEXT_BGSATURNO Then
                    
                    
                        Sheets("Base Geral").Select
                        ActiveCell.EntireRow.Copy
                        
                        Sheets("Tabela Agrupada").Select
                        ActiveCell.Offset(1, 0).PasteSpecial
                        Application.CutCopyMode = False
                        
                        
                        End If
                    
                    Sheets("Base Geral").Select
                    ActiveCell.Offset(1, 0).Select
                    
                Loop
                
        Sheets("Base Geral").Select
        Range("C2").Select
                
        Sheets("Tabela Saturno").Select
        ActiveCell.Offset(1, 0).Select
Loop

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic 'No final do código quando terminar o processo coloca esse para o excel voltar a calular.
MsgBox "Finalizado"


End Sub

 

Link para o comentário
Compartilhar em outros sites
  • 0
brunoramosd

brunoramosd

Postado
  • Autor
Postado
1 minuto atrás, Alyson Ronnan Martins disse:

Não compreendo a regra de negócio do sue código mais não seria melhor percorrer primeiro Geral e depois percorrer o Agrupado na comparação. 

Processo atual: 1 linha de Agrupado vai percorrer 60 mil linhas de Geral 
Processo proposto: 1 linha de geral vai verificar 6 mil linha de Saturno

Ou a maneira de compreender seu código está explicada de uma maneira muito simples e não entendi.

Então, é que eu preciso identificar na "Base Geral", se tem algum espaço para adicionar na "Tabela Saturno"

Ou seja:

Na Tabela Saturno eu tenho, 1, 2, 4, 5, 6.....
Quero identificar se na Base Geral eu encontro o 3

Se eu encontra o 3 ele vai levar para a Tabela Agrupada o 1, 2 (da Tabela Saturno) + 3 (Base Geral).

Conseguiu pegar a rotina?

Link para o comentário
Compartilhar em outros sites
  • 0
Alyson Ronnan Martins

Alyson Ronnan Martins

Postado
Postado (editado)

Um pouco do contexto sim.
Nesse caso se o procedimento poderia ser alterado para outra maneira? Exemplo:

A tabela "agrupado" recebe todas as linhas da tabela saturno
A tabela geral vai "ler" linha por linha na tabela agrupado:
  :Condicional: 
  

CEPINICIAL_BGGERAL > CEPFINAL_BGSATURNO And CEPINIOLD_BGGERAL < CEPINICIAL_BGGERAL And CEPFINAL_BGGERAL < CEPINICIALNEXT_BGSATURNO


  -->se encontrar ele pode inserir uma linha abaixo da linha agrupado e colocar o valor dentro (valor da tabela geral)
  -->se não encontrar ele pula para próxima linha da tabela geral

Olha se eu consegui explicar a lógica para você.

 

Editado por Alyson Ronnan Martins
Melhorar entendimento do texto
Link para o comentário
Compartilhar em outros sites
  • 0
Alyson Ronnan Martins

Alyson Ronnan Martins

Postado
Postado

Segue o link de uma planilha tentando melhorar o desempenho do código.
link: https://1drv.ms/x/s!ArTb7UjY-5CriJJjgPv4O28RbcqDrQ?e=P3XBbs

Como comentei acima acho que deveria mudar a sequência do seu código para melhorar o desempenho e parar de travar por não conseguir processar. Como não tenho uma base para fazer o teste eu não consigo fazer a avaliação então olha ai e vê como ficou.

 

Abraço.

Link para o comentário
Compartilhar em outros sites
  • 0
brunoramosd

brunoramosd

Postado
  • Autor
Postado
24 minutos atrás, Alyson Ronnan Martins disse:

Segue o link de uma planilha tentando melhorar o desempenho do código.
link: https://1drv.ms/x/s!ArTb7UjY-5CriJJjgPv4O28RbcqDrQ?e=P3XBbs

Como comentei acima acho que deveria mudar a sequência do seu código para melhorar o desempenho e parar de travar por não conseguir processar. Como não tenho uma base para fazer o teste eu não consigo fazer a avaliação então olha ai e vê como ficou.

 

Abraço.

Vou colocar em um drive aqui pra você a tabela, acho que consegues entender melhor com os dados.

Agradeço D+ conseguir ajustar, estou com prazo super apertado com o cliente, e o negócio não vai, batendo aquele desespero uhauahua.

https://drive.google.com/file/d/11NzyfJI8daM5wL-iJvzc0hAbwIiYpOny/view?usp=sharing

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...