Colar Dados Ultima ...
 
Notifications
Clear all

[Resolvido] Colar Dados Ultima Linha VBA SQL Condicional


JAlmeida
Posts: 31
Registered
Topic starter
(@jalmeida)
Eminent Member
Entrou: 4 anos atrás

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!

Responder
9 Respostas
1 Responder
JAlmeida
Registered
(@jalmeida)
Entrou: 4 anos atrás

Eminent Member
Posts: 31

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!

Responder
Anderson
Posts: 188
Registered
(@anderson)
Estimable Member
Entrou: 2 anos atrás

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
Responder
Raygsson
Posts: 66
Registered
(@raygsson)
Trusted Member
Entrou: 2 anos atrás

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;"
Responder
Anderson
Posts: 188
Registered
(@anderson)
Estimable Member
Entrou: 2 anos atrás
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("TU").Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"

MsgBox "Dados atualizados com sucesso!", vbOKOnly
[A2].Select
Call TurnOnStuff
application.screenupdating = true
End Sub
Responder
1 Responder
JAlmeida
Registered
(@jalmeida)
Entrou: 4 anos atrás

Eminent Member
Posts: 31

@anderson

Muito obrigado pela ajuda. Deu certo!

Responder
Raygsson
Posts: 66
Registered
(@raygsson)
Trusted Member
Entrou: 2 anos atrás

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("TU").Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"

rsConsulta.Close
ConexaoPlan.Close

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

 

Responder
1 Responder
JAlmeida
Registered
(@jalmeida)
Entrou: 4 anos atrás

Eminent Member
Posts: 31

@raygsson

Muito obrigado pela ajuda! Deu certo!

Responder