Exportar valor para outro arquivo Excel fazendo busca da linha certa

[tiagolpf]

Boa noite!

 

Tenho um arquivo de banco de dados (BD) e outros arquivos de formulário (Form1, Form2...), conforme abaixo:

 

BD

A-------B--C

1001--10--ok

1001--20--nao

1002--15--ok

 

Form1

A-------B--C

1001--20--ok

 

Como mostra o exemplo, o produto da linha 1 do Form1 é o mesmo da linha 2 do BD (1001-20).

No Form1 o valor da coluna C foi atualizado para "ok", então preciso que uma macro faça uma busca no BD pela linha que tenha valores iguais nas colunas A e B, e então substitua o valor da coluna C (de "nao" para "ok").

 

Desde já, obrigado!

[Basole]

tiagolpf, o que quer dizer form1, Form2.?  Se puder anexar um exemplo destacando o resultado que deseja,

 

facilita a quem possa ajuda-lo no entendimento do que voce precisa, 

 

abx.

[tiagolpf]

Form1 e Form2 são outros arquivos de Excel, são como formulários que atualizarão o banco de dados. Cada formulário será aberto por diferentes pessoas ao mesmo tempo, por isso não pode ser um arquivo só.

 

Fiz um exemplo para download:

https://drive.google.com/file/d/0Bzwg1pakNeIDNVhNbFZ4YUcxWnc/view?usp=sharing

[Basole]

Esta macro atualiza o BD sem a necessidade de abrir o arquivo.

Nos arquivos (Pasta de Trabalho) Form1 e Form2,  (alt+ f11) e crie um modulo e copie e cole o codigo abaixo. E edite o codigo (no local indicado), para alterar o diretorio do seu arquivo (BD).

Sub AtualizaBD()
    ' habilitado a ref. microsoft activeX data objects x.xx library
    Dim Conn As New ADODB.Connection
    Dim mrs As New ADODB.Recordset
    Dim DBPath As String, sconnect As String
    Dim ws As Worksheet: Set ws = ActiveSheet 'altere aqui sua plan (aba)
    Dim SQL As String
    Dim i As Long: i = 2 'inicio de dados a partir da 2ª linha
    
    DBPath = ThisWorkbook.FullName ' altere aqui o diretorio do "arq. BD" - ex.: "C:\Temp\BD.xlsx"
    While ws.Range("a" & i).Value <> ""
        sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes;"

        Conn.Open sconnect
        SQL = "UPDATE [bD$]" & _
              " SET [OM] ='" & ws.Range("a" & i).Value & "'" & _
              ", [status] = '" & ws.Range("d" & i).Value & "'" & _
              " WHERE [Desc] = '" & ws.Range("c" & i).Value & "'"

        i = i + 1 'soma a linha atual a um linha abaixo
        Set mrs = New ADODB.Recordset
        mrs.Open SQL, Conn
        Set mrs = Nothing ' limpa o recordset
        
        Conn.Close 'fecha conexao
    Wend ' faz o loop
    MsgBox "Dados atualizadono BD com sucesso!", 0, " SUCESSO"
End Sub

exemplo-v1.rar

[tiagolpf]

Muito legal, obrigado!

 

Só tem um detalhe, ao atualizar os dados no BD, é preciso que a macro compare a coluna A e B. Pelos testes que fiz, está comparando apenas a A.

[Basole]

Só tem um detalhe, ao atualizar os dados no BD, é preciso que a macro compare a coluna A e B. Pelos testes que fiz, está comparando apenas a A.

Não entendi, somente atualizar o "status" se as coluna A e B forem iguais as coluna A e B do BD,  é isso? 

[tiagolpf]

Exato! Na coluna A alguns números se repentem, e o que diferencia um item do outro é a coluna B.

 

Trazendo para a realidade, isso é referente a Ordems de Manutenção (OM), e estas ordens tem Sub Operações (Sub).

 

Ex:

OM 1001 - Revisão de motor elétrico

 

Sub 10 - Desconexão elétrica

Sub 20 - Desacoplamento

Sub 30 - Manutenção

Sub 40 - Acoplamento

Sub 50 - Conexão elétrica

 

Então, ao atualizar um status, a macro precisa encontrar a OM e a Sub correspondente.

[Basole]

Veja agora, a macro vai atender a 2 criterios:

 

Só atualizará o "Status" se ->  valor [ = ] coluna A e valor  [ = ] a coluna B.

 

Abx. 

 

Sub AtualizaBD()
    '  *** Habilitar a ref. microsoft activeX data objects x.xx library
    Dim Conn As New ADODB.Connection
    Dim mrs As New ADODB.Recordset
    Dim DBPath As String, sconnect As String
    Dim ws As Worksheet: Set ws = ActiveSheet 'altere aqui sua plan(aba) ex.: [ Sheets("Form1") ]
    Dim SQL As String
    Dim i As Long: i = 2 'inicio de dados a partir da 2ª linha
    
    DBPath = ThisWorkbook.Path & "\exemplo.xlsx" ' altere aqui o diretorio do "arq. BD" - ex.: "C:\Temp\BD.xlsx"
    While ws.Range("a" & i).Value <> ""
        sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes;"

        Conn.Open sconnect
        SQL = "UPDATE [bD$]" & _
              " SET [OM] = '" & ws.Range("a" & i).Value & "'" & _
              ", [status] = '" & ws.Range("d" & i).Value & "'" & _
              " WHERE _{=" & ws.Range("b" & i).Value & _
              " And [Desc] = '" & ws.Range("c" & i).Value & "';"
Debug.Print SQL
        i = i + 1 'soma a linha atual a um linha abaixo
        'Set mrs = New ADODB.Recordset
        mrs.Open SQL, Conn
        Set mrs = Nothing' limpa o recordset
        
        Conn.Close 'fecha conexao
    Wend' faz o loop
    MsgBox "Dados atualizadono BD com sucesso!", 0, " SUCESSO"
EndSub}

[tiagolpf]

Perfeito, funcionou!

Porém, quando alterei os dados para os arquivos originais, deu o erro "Erro de compilação: O tipo definido pelo usuário não foi definido"

Também fiquei com muitas dúvidas quando fiz as alterações. Poderia me ajudar?

Obrigado!

 

 

Sub transfere()
    '  *** Habilitar a ref. microsoft activeX data objects x.xx library
    Dim Conn As New ADODB.Connection 'Aqui está sendo destacado o erro.
    Dim mrs As New ADODB.Recordset
    Dim DBPath As String, sconnect As String
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim SQL As String
    Dim i As Long: i = 4 'Alterei para 4 porque os dados no banco começam na linha 4.
    
    DBPath = "D:\Programação\Semana XX.xlsm" 'Redirecionei para o banco de dados.
    While ws.Range("d" & i).Value <> "" 'Alterei para "d" porque é a coluna das OM no formulário.
        sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes;"

        Conn.Open sconnect
        SQL = "UPDATE [Programação$]" & _ 'Esta é a planilha do banco de dados.
              " SET [OM] = '" & ws.Range("d" & i).Value & "'" & _ 'Alterei para D porque é a coluna das OM no formulário (planilha ativa). Ou deveria ser a do banco de dados? No banco de dados a coluna das OM é a B.
              ", [status] = '" & ws.Range("k" & i).Value & "'" & _ 'Mesma coisa aqui, o Status está na coluna k do formulário.
              " WHERE [Sub] =" & ws.Range("e" & i).Value & _ ' "Sub" é referente ao BD ou ao formulário? O "e" é referente ao formulário, certo?
              " And [Descrição] = '" & ws.Range("g" & i).Value & "';" 'A Descrição está sendo comparada? A comparação poderia ser só pela OM e Sub? Porque a Descrição as vezes pode se repetir em OM e Sub diferentes.
Debug.Print SQL
        i = i + 1
        'Set mrs = New ADODB.Recordset
        mrs.Open SQL, Conn
        Set mrs = Nothing
        
        Conn.Close
    Wend
    MsgBox "Dados atualizadono BD com sucesso!", 0, " SUCESSO"
End Sub

[Basole]

Perfeito, funcionou!Porém, quando alterei os dados para os arquivos originais, deu o erro "Erro de compilação: O tipo definido pelo usuário não foi definido"

Esse erro causado, informado acima é em função de que faltou  (*** Habilitar a ref. microsoft activeX data objects x.xx library), que nao vem habilitado por defalut no excel.

Abra o editor vba ( Alt + F11 ), vá na aba Ferramentas, selecione Referencias e marque a opção: "Microsoft activeX data objects 2.8 library", "2.7", ou a que estiver disponivel.

 

Abaixo 'passei a limpo' o codigo de acordo c/ as inf. que você passou. 

 

Sub transfere()

    '  *** Habilitar a ref. microsoft activeX data objects x.xx library

    Dim Conn As New ADODB.Connection

    Dim mrs As New ADODB.Recordset

    Dim DBPath As String, sconnect As String

    Dim ws As Worksheet: Set ws = ActiveSheet

    Dim SQL As String

    Dim i As Long: i = 4

    

    DBPath = "D:\Programação\Semana XX.xlsm" 'Redirecionei para o banco de dados.

    While ws.Range("d" & i).Value <> ""

        sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes;"

        Conn.Open sconnect

        SQL = "UPDATE [Programação$]" & _

              " SET [OM] = " & ws.Range("d" & i).Value & _

              ", [status] = '" & ws.Range("k" & i).Value & "'" & _

              " WHERE _{=" & ws.Range("e" & i).Value}

        _{i = i + 1}

        _{Set mrs = New ADODB.Recordset}

        _{mrs.Open SQL, Conn}

        _{Set mrs = Nothing}

        

        _Conn.Close

    _Wend

    _{MsgBox "Dados atualizadono BD com sucesso!", 0, " SUCESSO"}

_EndSub

 

_'Abx. 

[tiagolpf]

Ah, certo.

 

Mas agora deu outro erro. Desculpe tantas perguntas, mas não entendo de programação.

 

Erro em tempo de execução '-2147217900 (80040e14)':

 

[Microsoft][Driver ODBC Excel] Erro de sintaxe (operador faltando) na expressão de consulta '1006', [status] = 'Concluído' WHERE _{= 10'.}

_{Como já disse, não entendo de programação, mas tem uma coisa que achei estranho na macro...}

_{Como as colunas de OM, Sub, etc são diferentes no BD e no formulário, não seria preciso especificar na macro onde elas ficam? Pelo que notei, só estão especificadas as do formulário (d, e, k).}

[Basole]

Como as colunas de OM, Sub, etc são diferentes no BD e no formulário, não seria preciso especificar na macro onde elas ficam? Pelo que notei, só estão especificadas as do formulário (d, e, k).

Não a macro encontra pelo nome do campo [ OM ], _{etc.....independente da coluna que estiver.}

_{Me parece que alterou este trecho do codigo e inseiu aspas simples para o campo que é numerico. Qualquer espaço ou aspas a + ou a - faz diferença.} 

_{Pra mim aqui estra funcionando perfeitamente.}

 

_{Tente isso, altere a respect. linha por esta:}

" WHERE [Sub] =" & ws.Range("e" & i) & ";" 

[tiagolpf]

Basole, não sei mais o que fazer além de te enviar os arquivos originais. Já estou me sentindo constrangido. rsrs

 

https://drive.google.com/file/d/0Bzwg1pakNeIDNlNhWVMyUHJQODQ/view?usp=sharing

[Basole]

Tudo bem relaxa meu brother

 

Em uma tabela de banco de dados, voce não pode colocar nada acima dos campos e nem linhas vazias.

 

Então eu exclui as linhas acima e onde tinha 'SEMANA 50' eu coloquei em uma caixa de texto suspensa,  e fiz algumas inversões no codigo, agora deve funcionar de acordo. 

 

Abx. 

 

 

 

 

 

excel-2.zip

[tiagolpf]

Funcionando! Muito obrigado, Basole!

 

Estou tentando acrescentar dados de mais colunas para serem transferidas, mas não estou conseguindo.

 

Por exemplo, como faço para transferir a coluna L também?

 

Acredito que seja aqui:

 

SQL = "UPDATE [Programação$]" & _
              " SET [Op] =" & ws.Range("e" & i).Value & _
              ", [Estado] = '" & ws.Range("k" & i).Value & "'" & _
              " WHERE [OM] =" & ws.Range("d" & i).Value
        i = i + 1

[tiagolpf]

Consegui, finalmente tudo funcionando.

Muito obrigado pela grande ajuda!

 

        SQL = "UPDATE [Programação$]" & _
              " SET [Op] =" & ws.Range("e" & i).Value & _
              ", [Estado] = '" & ws.Range("k" & i).Value & "'" & _
              ", [HH Real] = '" & ws.Range("l" & i).Value & "'" & _
              ", [sAP] = '" & ws.Range("m" & i).Value & "'" & _
              ", [Obs] = '" & ws.Range("n" & i).Value & "'" & _
              " WHERE [OM] =" & ws.Range("d" & i).Value
        i = i + 1
 

[Basole]

Opa desculpe estive 1/2 ocupado, pegou fácil o fio da meada... é isso ai mesmo, certinho !!!

 

No arq. "Semana XX" eu nomei o intervalo [ $A$3:$P$500 ], como "tbProgramacao", e a macro 'enxerga' este intervalo como sendo uma tabela, então voce pode usar este mesmo lay-out (que estava usando anterirmente), que nao terá problemas.  Caso os DADOS utrapassam a linha  500, voce deve ajustar esse intervalo.

Caso for usar desta forma altere então no codigo, esta linha (abaixo),  com o novo nome da tabela: 

 SQL = "UPDATE [tbProgramacao]" & _

Abx.

 

excel-3.zip

[tiagolpf]

Legal, entendi. É uma ótima solução mesmo quando a planilha não é exclusivamente de banco de dados.

 

Vi que acrescentou duas linhas novas também que no outro não tinha.

 

        Set mrs2 = New ADODB.Recordset
        SQL2 = "SELECT [HH Real] FROM [tbProgramacao]"

 

Está funcionando sem estas duas linhas, mas para que servem?