Notifications
Clear all

[Resolvido] Colar Dados Ultima Linha VBA SQL Condicional


JosenildoA
(@josenildoa)
Eminent Member Registered
Entrou: 3 anos atrás
Posts: 24
Topic starter  

Pessoal, boa noite!

Gostaria de uma ajuda para um projeto de atualização de dados. Tenho um relatório que todos os dias importo valores antigos liquidados e outro que atualizo com essas informações por data de pagamento (ambos relatórios no mesmo arquivo). A idéia da macro que criei é, quando a coluna J (Recebimento) estiver preenchida com uma data (dia do recebimento), ela copia todo esse intervalo (menos os que não tem data) e cola no relatório Recebimento, a partir da ultima linha preenchida, tipo sequencial, entretanto, não está dando certo. Estou anexando o arquivo-exemplo com a macro (VBA/SQL) para ajuda de vocês. Preferi fazer com SQL dado o volume de dados dos relatórios envolvidos.

Obrigado!


ResponderCitar (Quote)
Anderson
(@anderson)
Estimable Member Registered
Entrou: 12 meses atrás
Posts: 172
 

Talvez seja interessante adicionar o campo Status à tabela, como é feito neste vídeo a partir de 1h06min:

https://youtu.be/CTq_aV6XSwU

 shRec.Range("A" & shRec.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row).CopyFromRecordset rsConsulta
Este post foi modificado 2 meses atrás 4 vezes por Anderson

Em 90% dos casos em que não se anexa o arquivo, ocorrem mal-entendidos, gerando perda de tempo de ambos os lados.


JosenildoA curtiu
ResponderCitar (Quote)
Raygsson
(@raygsson)
Eminent Member Registered
Entrou: 8 meses atrás
Posts: 47
 

Na linha de conexão declarar o caminho completo da sua planilha com o "FullName" fica melhor também, se renomear não vai precisar ficar alterando o nome no código, mas é apenas detalhe.

 ConexaoPlan.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source =" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0;"

JosenildoA curtiu
ResponderCitar (Quote)
JosenildoA
(@josenildoa)
Eminent Member Registered
Entrou: 3 anos atrás
Posts: 24
Topic starter  

Anderson, Raygsson, boa noite!

Muito obrigado pela ajuda! Fiz uma adaptação para outro arquivo mas agora está dando um erro em tempo de execução (nenhum valor foi fornecido para um ou mais parâmetros ...)

Poderiam me ajudar a identificar esse erro? Estou anexando o arquivo com a sql.

Obrigado!


ResponderCitar (Quote)
JosenildoA
(@josenildoa)
Eminent Member Registered
Entrou: 3 anos atrás
Posts: 24
Topic starter  

@anderson

Fiz de acordo com suas orientações e deu super certo! Muito obrigado!

Entretanto, ao adaptar ao arquivo original, com fórmulas nomeadas (o que necessariamente precisa ter por questões de atualização financeira), na hora de atualizar o aba histórico os campos perdem o formato. Tentei várias ações mas não deu certo. Se importa em tentar me ajudar nesse sentido? Estou anexando os arquivos para demonstração/testes.


ResponderCitar (Quote)
JosenildoA
(@josenildoa)
Eminent Member Registered
Entrou: 3 anos atrás
Posts: 24
Topic starter  

@anderson

Boa tarde, tudo bem? Primeiramente, feliz Ano Novo, com muita saúde e paz!!

Perfeita sua solução, entretanto, ao adaptar o código tive um problema de delay, considerando a função de conversão CDbl tendo o início na linha 3 com a estrutura While. O relatório de Histórico tem mais de 10.000 linhas e essa atualização fica muito, muito demorada.

Se ao invés de convertermos os dados da aba Histórico (após a cópia), antes deletássemos as linhas da aba Controle, cujo campo Data_Pagamento esteja vazio, via SQL, não seria mais rápida a atualização sem a necessidade de conversão?

Pensei algo assim (Via SQL): Primeiro deletaríamos as linhas do campo Data_Pagamento (Sem dados), aba Controle, depois usaríamos o copyfromrecordset para despejar os dados (com datas) na aba Histórico. O que acha, seria possível?

Grato pelo apoio.

Este post foi modificado 2 meses atrás por JosenildoA

ResponderCitar (Quote)
Anderson
(@anderson)
Estimable Member Registered
Entrou: 12 meses atrás
Posts: 172
 
Sub AtualizaDados()
Call TurnOffStuff

Dim Arquivo As Variant
Arquivo = Application.GetOpenFilename("Abrir Arquivo, *.xls")
Workbooks.Open Arquivo

Set Arquivo = ActiveSheet
With Arquivo
.Rows("1:7").EntireRow.Delete
.Columns("A").Replace what:="1", Replacement:="Zona Sul"
.Columns("A").Replace what:="3", Replacement:="Superdelli"
.Columns("B").Replace what:="-", Replacement:=""
.Columns("E").Insert
.Columns("J").Cut Columns("E")
End With

Windows("Relat_Faturamento_IV").Activate
shControle.ListObjects("Tab_Base").AutoFilter.ShowAllData
shControle.ListObjects("Tab_Base").DataBodyRange.Delete

Arquivo.Range("A1").CurrentRegion.Copy
Range("A3").PasteSpecial Paste:=xlPasteValues

Arquivo.Activate
ActiveWorkbook.Close SaveChanges:=False

MsgBox "Dados Atualizados com Sucesso!", vbOKOnly, "Departamento de Contas a Pagar"
[A4].Select
Call TurnOnStuff
End Sub
Sub AtualizaHistorico()
application.screenupdating = false
Call TurnOffStuff
Dim ConexaoPlan As New ADODB.Connection
Dim rsConsulta As New ADODB.Recordset
Dim Sql As String
Dim linha As Long
linha = shHistorico.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ConexaoPlan.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source =" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0;"
ConexaoPlan.Open

Sql = "Select * From [Controle$] Where IsNull(Data_Pagamento) = False"
rsConsulta.Open Sql, ConexaoPlan, adOpenKeyset, adLockOptimistic

shHistorico.Range("A" & shHistorico.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row).CopyFromRecordset rsConsulta

rsConsulta.Close
ConexaoPlan.Close




While shHistorico.Range("P" & linha).Value <> ""

shHistorico.Range("P" & linha).Value = CInt(shHistorico.Range("P" & linha).Value)
shHistorico.Range("W" & linha).Value = CInt(shHistorico.Range("W" & linha).Value)
shHistorico.Range("Y" & linha).Value = CInt(shHistorico.Range("Y" & linha).Value)

shHistorico.Range("R" & linha).Value = CDbl(shHistorico.Range("R" & linha).Value)
shHistorico.Range("S" & linha).Value = CDbl(shHistorico.Range("S" & linha).Value)
shHistorico.Range("V" & linha).Value = CDbl(shHistorico.Range("V" & linha).Value)
shHistorico.Range("T" & linha).Value = CDbl(shHistorico.Range("T" & linha).Value)
shHistorico.Range("U" & linha).Value = CDbl(shHistorico.Range("U" & linha).Value)

linha = linha + 1


Wend

shHistorico.Select
shHistorico.Range("T:T,U:U").Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"

MsgBox "Dados atualizados com sucesso!", vbOKOnly
[A2].Select
Call TurnOnStuff
application.screenupdating = true
End Sub
Este post foi modificado 2 meses atrás por Anderson

Em 90% dos casos em que não se anexa o arquivo, ocorrem mal-entendidos, gerando perda de tempo de ambos os lados.


ResponderCitar (Quote)
Raygsson
(@raygsson)
Eminent Member Registered
Entrou: 8 meses atrás
Posts: 47
 

Já tem um comando pra excluir as datas vazias no SQL "IsNull(Data_Pagamento) = False"

Pra otimizar a atualização + formatação do histórico eu colocaria um loop de formatação direto num loop pra descarregar o RecordSet.

É mais rápido que um loop normal linha a linha da planilha. Fiz o teste aqui e demorou 1 segundo pra atualizar + formatar.

 

Sub AtualizaHistorico()
Call TurnOffStuff
Dim ConexaoPlan As New ADODB.Connection
Dim rsConsulta As New ADODB.Recordset
Dim Sql As String, i As Double
Dim tempo As Variant

tempo = Now

ConexaoPlan.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source =" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0;"
ConexaoPlan.Open

Sql = "Select * From [Controle$] Where IsNull(Data_Pagamento) = False"
rsConsulta.Open Sql, ConexaoPlan, adOpenKeyset, adLockOptimistic

i = shHistorico.Cells(Rows.Count, 1).End(xlUp).Row + 1
Do While Not rsConsulta.EOF
shHistorico.Cells(i, 1) = rsConsulta(0)
shHistorico.Cells(i, 2) = rsConsulta(1)
shHistorico.Cells(i, 3) = rsConsulta(2)
shHistorico.Cells(i, 4) = rsConsulta(3)
shHistorico.Cells(i, 5) = rsConsulta(4)
shHistorico.Cells(i, 6) = rsConsulta(5)
shHistorico.Cells(i, 7) = rsConsulta(6)
shHistorico.Cells(i, 8) = rsConsulta(7)
shHistorico.Cells(i, 9) = rsConsulta(8)
shHistorico.Cells(i, 10) = rsConsulta(9)
shHistorico.Cells(i, 11) = rsConsulta(10)
shHistorico.Cells(i, 12) = rsConsulta(11)
shHistorico.Cells(i, 13) = rsConsulta(12)
shHistorico.Cells(i, 14) = rsConsulta(13)
shHistorico.Cells(i, 15) = rsConsulta(14)
shHistorico.Cells(i, 16) = CInt(rsConsulta(15))
shHistorico.Cells(i, 17) = rsConsulta(16)
shHistorico.Cells(i, 18) = CDbl(rsConsulta(17))
shHistorico.Cells(i, 19) = CDbl(rsConsulta(18))
shHistorico.Cells(i, 20) = CDbl(rsConsulta(19))
shHistorico.Cells(i, 21) = CDbl(rsConsulta(20))
shHistorico.Cells(i, 22) = CDbl(rsConsulta(21))
shHistorico.Cells(i, 23) = CInt(rsConsulta(22))
shHistorico.Cells(i, 24) = rsConsulta(23)
shHistorico.Cells(i, 25) = CInt(rsConsulta(24))
i = i + 1
rsConsulta.MoveNext
Loop

shHistorico.Range("T:T,U:U").Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"

rsConsulta.Close
ConexaoPlan.Close

MsgBox "Dados atualizados com sucesso em " & Format(Now - tempo, "HH:MM:SS"), vbInformation, "Aviso."
[A2].Select
Call TurnOnStuff
End Sub

 


ResponderCitar (Quote)
JosenildoA
(@josenildoa)
Eminent Member Registered
Entrou: 3 anos atrás
Posts: 24
Topic starter  

@raygsson

Muito obrigado pela ajuda! Deu certo!


ResponderCitar (Quote)
JosenildoA
(@josenildoa)
Eminent Member Registered
Entrou: 3 anos atrás
Posts: 24
Topic starter  

@anderson

Muito obrigado pela ajuda. Deu certo!


ResponderCitar (Quote)