Jump to content

Pesquisa e Registo sem PROCV


Pedro12345

Recommended Posts

Boa tarde a todos,

Necessito da vossa ajuda.

Estou a ter alguma dificuldade em conseguir pesquisar nas linhas de uma coluna informação passada de outro separador.

A ideia é aproveitar a informação de um separador de Registo e passar os dados desse mesmo registo para a atualização em novas colunas de um separador de base de dados no Excel

Na imagem o Separador Registo, onde o registo "2017-1" é a chave a pesquisar na BD. Os campos a azul, têm na fórmula o PROCV, onde estou a ir buscar à BD os campos preenchidos pelo Registo " 2017-1". A ideia é o utilizador neste separador colocar o registo a pesquisar (2017-1 / 2017-2, etc..) (aparecendo através do PROCV os campos a azul já registados BD) e preencher depois os campos a amarelo. A ideia agora é pegar nos valores das células correspondente à cor amarelo, ir ao separador BD, procurar na coluna C o registo "2017-1" e preencher na coluna G e H os novos campos preenchidos, desse mesmo registo colocado.

Tenho já criado o Separador Registo:

https://i.postimg.cc/QCmtHB17/AApD0Mv.jpg

E dados já preenchidos no Separador BD, onde os campos a amarelo são os campos a serem preenchidos conforme registo colocado no separador registos..

https://i.postimg.cc/MZmXsLNG/PBq90xh.jpg

Já desenvolvi o seguinte código e necessito de algum feedback sobre o mesmo, face a estar com erros..

Sub Sorriso1_Click()
'
' buscavalor Macro
'
	Application.ScreenUpdating = False

        Dim reg As String

		Dim nome As String
        Dim emm As String

        
        'Variavel ultima linha com valores da Base de Dados
        Dim UltimaLinha As Integer
        
        'Pega valor do registo "2017-#"
        reg = Range("B2").Value

		'Pega valor preenchido pelo utilizador para passar para registo da BD
        nome = Range("B8").Value
        emm = Range("B9").Value

		
        'Após colocação dos campos acima pelo utilizador ele passa para o Separador BD
        Sheets("BDA").Select
            
		'Regista o número de Linhas já preenchidas da Base de Dados para diminuir as linhas de procura
        UltimaLinha = Range("C1048576").End(xlUp).Row + 1
        
        
        Do Until ActiveCell = reg
        
        	ActiveCell.Offset(1, 0).Select 'desce uma linha

        	If ActiveCell = reg Then   'faz a análise lógica

				ActiveCell.Offset(0, 5).Select 'desloca para a coluna G
            	ActiveCell.FormulaR1C1 = nome
				ActiveCell.Offset(0, 1).Select 'desloca para a coluna H
				ActiveCell.FormulaR1C1 = emm
			End If
		Loop
End Sub
'Creio que em vez do ciclo Do Until, possa fazer através de um For Registo ou um ciclo IF...
'Do género:
Ultimalinha = ActiveCell.Row + 1 'pega ultima linha preenchida
'Range("C" & Ultimalinha).Select 'coloca o curso na mesma
For i = 1 To ultimalinha 'percursso o ciclo da primeira à ultima linha preenchida da coluna Registo "2017-1, até 2017-ultimo registo"
        Range("C" & i).Select
	If(Range"C" & i).Value = Reg 'Se encontrar registo 2017-1 na coluna C
		Range("G" & Reg).Value = nome 'Vai à coluna G dessa mesma linha e coloca o valor que deu ao nome no separador registo
		Range("H" & Reg).Value = emm 'Vai à coluna H dessa mesma linha e coloca o valor que deu ao emm no separador registo
	End If 'termina ciclo
Next i 'termina ciclo

'Voltar para Separador Registo
 Sheets("Registos").Select
'Posiciona Cursor no B2, no do Registo
    Range("B2").Select

Esta segunda parte talvez fosse mais direta, mas mesmo assim estou com dificuldade, estando a pensar se preciso do For e do IF.

Cada Registo é único na coluna C, havendo sempre só um..

Até estava na ideia se o Registo colocado for por exemplo "2017-5" aparecer uma MsgBox dizendo "Registo não existe na BD" e se passar para lá com sucesso MsgBox "Registo 2017-X  Atualizado"

Alguém me pode dar umas dicas?

Obrigado desde já.

Link to comment
Share on other sites

Boas, não seria mais fácil criares uma tabela em Access, de onde irias ler os valores que pretendes, e atualizar os campos mais facilmente, mesmo que acedidos por Excel? 

Já há muito tempo que não uso isto, mas deixo-te aqui um exemplo que eu usava , possivelmente terás que atualizar o tipo de ligação (acho que já não é ADOBD),  e no editor de Visual Basic tens de ir a tools, references e adicionares a referencia à versão de access que está na tua máquina, se pesquisares um bocado deverás encontrar exemplos melhores e mais atuais.

Dim cn As Object, rs As Object
  DBFullName = "D:\OFICIOS\naomexer\Dados Autos.mdb"

On Error GoTo Erro

Dim comando As String
'procura o campo Nome na tabela NIF_Tabela que corresponde ao campo NIF, que foi inserido no campo niffiel do formulário 
comando = "SELECT NOME FROM NIF_Tabela WHERE NIF = '" & UserForm1.niffiel.Text & "'"

Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"

Set rs = CreateObject("ADODB.Recordset")
'Set rs2 = CreateObject("ADODB.Recordset")


rs.Open comando, cn, , , adCmdText


nomefiel.Text = rs!nome

LetsContinue:

On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
On Error GoTo 0
Exit Sub
Erro:
    ' esta descrição do erro ia aparecer sempre que não houvesse morada
 'MsgBox "Error Description :" & Err.Description & vbCrLf & _
             "Error at line     :" & Erl & vbCrLf & _
             "Error Number      :" & Err.Number
Resume LetsContinue
      
      
      
      
 'update dos campos
Dim nif, nome, nif2, nome1 As String
nif = Me.novonif.Value
nif2 = Me.AlterarNif.Value
nome1 = Me.novonome.Value
comando = "UPDATE NIF_Tabela SET NIF='" & nif & "', NOME = '" & nome & "'    WHERE NIF= '" & nif2 & "'"
      

Este código estava inserido no evento Click de um botão.

Para alterares valores na tabela é basicamente a mesma coisa, mas a instrução SQL tem que ser qualquer coisa como está no update dos campos.

A parte do update é um código à parte, igual ao primeiro só com as alterações que deixo no fim.

 

Esta é uma opção possível, no entanto deverão existir muitas mais, utilizando o código que tens.

Boa sorte.


      
                    

Férias! Estou por aqui: http://maps.google.p...001549&t=h&z=20 (a bulir claro está!)

Nunca mais é verão outra vez.. :)

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.