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

Confecção de código VBA para Excel


Adriano_Aragão

Pergunta

Boa tarde!

Meu nome é Adriano e eu não sou programador de linguagem nenhuma. Sou um entusiasta que procuro fazer algumas macros que facilitem algumas tarefas do meu dia a dia.
Com a ajuda de Inteligências Artificiais eu consegui fazer dois códigos em VBA para copiar um intervalo de dados da planilha1 para a planilha2.
O intervalo de dados copiado deve atender a solicitação do usuário.

O primeiro código está funcionando bem, porém é muito lento, faz a cópia linha a linha;
No segundo código está bem rápido, inicia a cópia com a data solicitada pelo usuário porém copia todas as datas seguintes.
A base de dados que eu quero filtrar, por vezes, contém mais de 30.000 linhas.

Os dados de origem estão na coluna A da planilha1;
Eu quero encontrar e copiar, no intervalo de células preenchidas da planilha1, um intervalo de células que contenham a data solicitada pe usuário.
Uma vez encontrado e copiado esse intervalo de dados (intervalo que contenha a data solicitada pelo usuário) colar na na célula A1 da planilha2.

Alguém poderia verificar para mim os códigos e sugerir correções?
Fico grato.

Código 1: 

Sub CopiaCola()
    Dim i As Range
    Dim PrimeiraLinha As Integer
    Dim LinOrigem As Integer
    Dim LinDestino As Integer
    
    LinOrigem = 1
    LinDestino = 1
        
    Planilha2.Cells.ClearContents
    
    ' Defina a data que você deseja procurar (no formato de texto)
    Dim dataProcurada As String
    dataProcurada = InputBox("Digite a data que deseja procurar (formato: MM/DD)")
    
    Set i = Planilha1.Range("A:A").Find(dataProcurada)
    
    PrimeiraLinha = i.Row
    
    If Not i Is Nothing Then ' Verificar se o dado foi encontrado
        
        Do
            Planilha1.Range("A" & i.Row).EntireRow.Copy Planilha2.Range("A" & LinDestino)
            LinDestino = LinDestino + 1
            
            Set i = Planilha1.Range("A:A").FindNext(i)
            LinOrigem = LinOrigem + 1
        
        Loop While Not i Is Nothing And PrimeiraLinha <> i.Row
        
    Else
        MsgBox "A data '" & dataProcurada & "' não foi encontrada na Planilha1.", vbExclamation
    End If
    
End Sub

Código 2:

Sub CopiaCola()

Dim i As Range
Dim PrimeiraLinha As Integer
Dim UltimaLinha As Integer

PrimeiraLinha = 1

Planilha2.Cells.ClearContents

' Defina a data que você deseja procurar (no formato de texto)
Dim dataProcurada As String
dataProcurada = InputBox("Digite a data que deseja procurar (formato: MM/DD)")

Set i = Planilha1.Range("A:A").Find(dataProcurada)

If Not i Is Nothing Then ' Verificar se o dado foi encontrado

    PrimeiraLinha = i.Row
    UltimaLinha = Planilha1.Cells(i.Row, "A").End(xlDown).Row

    Planilha1.Range("A" & PrimeiraLinha & ":A" & UltimaLinha).EntireRow.Copy Planilha2.Range("A1")

Else
    MsgBox "A data '" & dataProcurada & "' não foi encontrada na Planilha1.", vbExclamation
End If
End Sub

Link para o comentário
Compartilhar em outros sites

1 resposta a esta questão

Posts Recomendados

  • 0

Boa tarde. 
Olhando o código vi que colocou duas vezes o código “CopiaCola”. Pode ter sido apenas aqui no fórum. 
Para aumentar a velocidade ou desempenho do seu código recomendado desativar as atualizações de tela e atualização de cálculos. Isso melhora muito porque a macro não vai ter que esperar atualizar tela ou calcular as coisas. 
 

sub CopiaCola()
'Desativar a atualizado e calculo
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Seu código
...

'Ativar novamente a atualização e calclo
Application.ScreenUpdating = originalScreenUpdating
    Application.Calculation = originalCalculation

end sub

Claro que para melhorar o desempenho as vezes você deve pensar ao contrário de uma lógico comum. 
Qual o real objetivo para levar as informações em outra tabela?

Será que não poderia pegar o resultado que você espera usando outra solução em VBA?

Mesmo assim se fosse necessário pegar essas informações eu acho que tentaria usar SQL na planilha. (Mais só testando para ver se daria certos)

Espero ter ajudado 

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.



  • Estatísticas dos Fóruns

    • Tópicos
      152,1k
    • Posts
      651,8k
×
×
  • Criar Novo...