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
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
Pergunta
Adriano_Aragão
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
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.