Jump to content

Recommended Posts

Posted

Boa tarde a todos.

Numa aplicação tenho uma lista de clientes cuja procura é feita através de um valor introduzido numa textbox. Ao digitar os valores na textbox, uma listbox exibe os nomes que tem aqueles caracteres. Depois de seleccionar o nº pretendida na list fica na textbox o valor pretendido e os restantes dados em labels. Marcando checkboxs, informo a aplicação dos dados que pretendo alterar.

O critério de procura é feito através do Nº de Contribuinte, que na folha excell, se encontra na coluna "F".

Pretendia que me ajudassem com uma rotina que localizasse na folha excell, Col F, o número igual ao que foi seleccionado na textbox do userform.

Depois de encontrada a celula activa, com offset, posso fazer substituições nos dados gravados para esse cliente.

Tentei varias rotinas encontradas na Net, baseadas no metodo "FIND", mas sem sucesso.

Antecipadamente agradeço a ajuda e orientação possíveis.

Cumprimentos

Manuel António

Posted (edited)

Ora boas, para localizar podes usar o vlooup:

On Error Resume Next
NomeCaixadeTexto_onde_aparece_resultado = Application.WorksheetFunction.VLookup(CDbl(NomeCaixaTextoValoraPesquisar), Folha2.Range("A1:B10000"), 2, 0)

Nota que o VLookup só devolve valores que estejam a esquerda da célula a pesquisar.

Eu tenho NIF, Nome,NIF nesta pesquisa, ou seja ele vai procurar no NIF da direita, e devolve o nome que está à esquerda.

Boa Sorte

Edited by Gnrtuga

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

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

Posted (edited)

Boa noite, GNRTUGA.

Obrigado antes de mais pela rapidez na resposta.

Mas julgo que não é esse o meu objectivo, pois selecionando o NIF na textbox, a listbox dá-me toda a informação. O que necessito mesmo é da captura do endereço da célula que contém o NIF selecionado, para depois poder alterar os dados à esquerda e à direita da célula ativa conforme a necessidade, pois o cliente pode não mudar de morada mas os CTT podem mudar-lhe o código postal. Eu posso alterar-lhe os descontos.

Através do NIF, eu obtenho o nome, mas só preciso dele se houver antes um erro de introdução de dados e daí o nome estar errado ou o cliente alterar a designação social.

No entanto vou tentar obter algo da tua sugestão e vou ver se consigo dar a volta à questão.

De acordo com o que li em vários sites, a função "FIND", parece-me ser a adequada para estas situações, no entanto não consegui adaptar nenhum código de forma a que funcionasse na minha aplicação.

Como não percebo nada de programação, provavelmente foi por isso que não consegui adaptar, pois o pouquinho que sei foi aprendendo nos exemplos de sites e foruns. Auto didata, sabes!

Aos poucos, passo a passo, construí o userform num multipage, com 3 separadores. O primeiro faz a procura do cliente desejado, que depois de seleccionar o NIF, apresenta a identificação completa do cliente. O 2º separador contem os descontos atribuidos segundo as familias de produtos. O 3º separador, contem a informação necessária às alterações que houver no registo dos clientes e faz a introdução de dados de novos clientes.

Já me esquecia. O seu a seu dono.

Algumas das mais importantes rotinas que estou a aplicar, foram cedidas e ensinadas aqui no PAP pela gente fantástica que aqui dá ajuda e às quais nunca conseguirei agradecer o suficiente.

Vou então ver se consigo adaptar o código que envias.

Cumprimentos

Manuel Antonio

Edited by manuel antonio
Posted (edited)

Manuel António então deve ser algo assim que queres:

Dim pesquisa As Range
Set pesquisa = Folha1.Range("e:e").Find(processo.Value, LookIn:=xlValues, lookat:=xlWhole)
If pesquisa Is Nothing Then
MsgBox ("Processo não Encontrado"), vbExclamation, "Verifique se o valor introduzido está correcto!"
Else
With pesquisa
.Offset(0, -2) = "1"
.Offset(0, -3) = "-"
.Interior.ColorIndex = 45
End With
Call CommandButton3_Click ' aqui chama o processo que vai introduzir como se fosse um registo novo
 MsgBox ("Processo Actualizado!" & " " & iniciado.Text & " " & "Iiciados" & " " & concluido.Text & " " & "Concluídos"), vbInformation
End If

p.s eu também percebo pouco disto 🙂

os offset tens de ver quais são os que te interessam.. podes manter a mudança de cor para conseguires ver qual a célula que estás a alterar.

Edited by Gnrtuga

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

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

Posted (edited)

Boa tarde, GnrTuga.

On Error Resume Next
NomeCaixadeTexto_onde_aparece_resultado = Application.WorksheetFunction.VLookup(CDbl(NomeCaixaTextoValoraPesquisar), Folha2.Range("A1:B10000"), 2, 0)

Pegando na tua dica, corrigi da seguinte forma:

On Error Resume Next
TextBox1 = Application.WorksheetFunction.VLookup(CDbl(TextBox1.Value), Folha2.Range("E1:F2000"), 0, 0)

  ActiveCell.Select
'tentei fixar o endereço da célula que contem o NIF
  ActiveCell.Offset(0, -5).Select
'desloquei a célula activa 5 colunas para a esquerda
  ActiveCell = NOVODADO
'atribuí o valor da nova célula com a variável de uma inputbox.

Só que esta instrução não me grava o valor NOVODADO, na mesma linha que a célula que contém o NIF do cliente e nem semp+re me grava no mesmo lado.

Que variável devo mudar e que valores devo mudar, para que me grave o valor introduzido na mesma linha que contém o NIF que lhe corresponde?

Não estou mesmo a conseguir descortinar a falha.

Abraços

Manuel António

Edited by thoga31
GeSHi
Posted (edited)

Boa tarde, GnrTuga.

A rotina que envias foi uma das que tentei fazer funcionar, mas infelizmente diz-me sempre que não encontra valores:

Dim NIF As Range
       Set NIF = Folha2.Range("F1:F2000").Find(TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole)
       If NIF Is Nothing Then
       MsgBox ("Processo não Encontrado"), vbExclamation, "Verifique se o valor introduzido está correcto!"
       Else
       With NIF
       .Offset(0, -5) = NOVODADO

       .Interior.ColorIndex = 45
       End With
              End If

Retirei a chamada ao botão gravar, pois inseri a rotina no botão próprio para gravar os dados mediante determinadas circunstâncias, isto é, só grava mediante as checkbox seleccionadas.

Agradeço no entanto a ajuda e boa vontade e vou continuar a tentar.

Abraço

Manuel António

Edited by thoga31
GeSHi
Posted (edited)

Experimentaste copiar o valor a pesquisar, e colar na caixa de texto?

no .Offset(0,-5) = "novodado", em principio faltam as duplas aspas.

Experimenta alterar o range para uma só coluna tipo E:E ou F:F, que o resto trabalha-se com o Offset.

No editor do VBA o nome da folha que queres é mesmo Folha2 ? Nota que não é o nome do separador do Excel.

Pois aparentemente devia funcionar... se tiveres tentado tudo o que eu disse e não funcionar, podes colocar aqui o código todo?

Edited by Gnrtuga

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

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

Posted (edited)

boas tente assim, coloque o codigo num evento da textbox ou aonde pretender.

Private Sub CommandButton2_Click()
Dim RangColF As Range
Dim RangRow As Range
Set RangColF = Range("F2:F2000")
For Each RangRow In RangColF.Rows
If RangRow.Cells(1, 1) = TextBox.Text Then
RangRow.Cells(1, 1).Select
'aqui movimenta o ponteiro para a coluna pretendida.
'ActiveCell.Offset(0, 1).Value = "xxxxx"
Exit For
End If
Next
End Sub

cumps

acao

Edited by acao
Posted

Boa noite, Gnrtuga.

Não posso copiar o valor para a caixa de texto, pois o valor é fruto da leitura da aplicação da própria folha de cálculo. Isto é, com a rotina de uma listbox, gentileza de PMG do PaP, ao digitar um algarismo a listbox vai apresentando os numeros que contêm esse algarismo, se digitar dois a selecção já fica mais limitada, até encontrar na listbox o numero pretendido. Depois na listbox clico no numero que pretendo e ele e exibido na textbox para servir de variável de procura.

NOVODADO, é uma variável resultante da inserção de dados numa inputbox, por isso não pode ter "".

Embora o separador excell se chame "CLIENTES", é mesmo folha 2, isto é o segundo separador. Folha 1 contém o menu, e folha 2, corresponde ao terceiro separador. A verdade é que grava os dados só que em sítios errados e nem sempre na mesma coluna.

Tentei colocar o range desta forma F2:F2000, mas diz-me que não encontra valores.

Vou tentar dar mais uns retoques, partir um pouco mais a cabeça e depois coloco o código, para dares uma olhada.

Abraços. Bom fim de semana a todos.

M.A.

Posted (edited)

Gnrtuga, boa noite.

Tentei com método Find que enviaste, mas diz-me valor não encontrado, e como o código não está ainda completo, acaba por gravar mas não no sitio correto e nem sempre grava na mesma célula. Também não pinta a célula com cor 45

Retirei a mensagem a seguir ao chamamento da rotina do botão gravar, pois contem variáveis desconhecidas.

O código está estruturado conforme envio:

Private Sub CommandButton3_ALT_Click()
NNN:
If CheckBox1.Value = True Then
GoTo NN1
Else
Call CommandButton1_SAI_Click
Unload Me
End If

If CheckBox2.Value = True Then
GoTo NN2
Else
Call CommandButton1_SAI_Click
Unload Me
End If
If CheckBox3.Value = True Then
GoTo NN3
Else
Call CommandButton1_SAI_Click
Unload Me
End If
If CheckBox4.Value = True Then
GoTo NN4
Else
Call CommandButton1_SAI_Click
If CheckBox5.Value = True Then
GoTo NN5
Else
Call CommandButton1_SAI_Click
Unload Me
End If

NN1:
If CheckBox1.Value = False And CheckBox2.Value = False And CheckBox3.Value = False _
   And CheckBox4.Value = False And CheckBox5.Value = False Then
MsgBox " NÃO SELECCIONOU NENHUMA OPÇÃO."
Call CommandButton1_SAI_Click
Exit Sub
End If

N1:
Dim NOVODADO As String
NOVODADO = InputBox("" & vbLf & vbLf & "INSIRA O NOVO NOME.", "        ........ALTERAÇÃO DE DADOS........")
   If IsNumeric(NOVODADO) = True And NOVODADO = "" Then
   MsgBox " NÃO ALTERADO", vbCritical
   GoTo N1
   Else
   Label31.Caption = NOVODADO

On Error Resume Next
Dim PESQNIF As Range
       Set PESQNIF = Folha2.Range("F2:F2000").Find(TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole)
       If PESQNIF Is Nothing Then
       MsgBox ("NIF não Encontrado"), vbExclamation, "Verifique se o valor introduzido está correcto!"
       Else

       With PESQNIF
       .Offset(0, -5) = NOVODADO
       .Interior.ColorIndex = 45
       End With

       End If

   MsgBox "   N.I.F.  ENCONTRADO NA CELULA    >    " & ActiveCell.Address & vbCrLf & _
   "          REGISTO GRAVADO COM SUCESSO.  "
       End If
   CheckBox1.Value = False
   GoTo NNN
End If
'esta parte do código só corre se checkbox1 estiver seleccionada. Depois será para acrescentar o código para
'mais quatro checkbox.
End sub

Abraços

M.A.

Edited by thoga31
GeSHi
Posted (edited)

boas

tens aqui também o metodo find escolhe o que quiseres

mas atenção utilizar o metodo offset assim não é boa opção, se for selecionada outra celula no momento de passar os dados altera o lugar d celula,

e o cod que enviei anteriormente igual, mas foi você que pediu assim, eu prefiro o cod enviado acima mas com um range que selecione as colunas todas aonde são inseridos os dados e utilizar o range para gravar.

Dim RangNif as Range
If Trim(textBox.text) <> "" Then
	With Sheets("Folha2").Range("F2:F2000")
		Set RangNif = .Find(What:=textBox.text, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
		If Not RangNif Is Nothing Then
			Application.Goto RangNif, True
			ActiveCell.Offset(0, -5).Value = novodado
			ActiveCell.Offset(0, -5).Select
		Else
			MsgBox "NIF Não encontrado"
		End If
	End With
End If

cumps

acao

Edit: utilize assim;

Dim RangNif as Range
If Trim(textBox.text) <> "" Then
With Sheets("Folha2").Range("F2:F2000")
Set RangNif = .Find(What:=textBox.text, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not RangNif Is Nothing Then
'Application.Goto RangNif, True
Range(RangNif.Address).Offset(0, -5).Value = novodado
Else
MsgBox "NIF Não encontrado"
End If
End With
End If

cumps

acao

Edited by acao
Posted

Manuel António, o teu código para mim esta um bocadinho confuso 🙂

Não encontro o procedimento que vai chamar o N1 (que é o que vai chamar a pesquisa), vejo um a chamar o NN1... e no NN1 se as checkbox estiverem vazias aparece a mensagem a dizer que não foi alterado, mas quando elas estão seleccionadas o que acontece? Não devias chamar ai o N1?

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

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

Posted

Bom dia, antes de mais, a Gnrtuga e Acao.

Acao,

ainda não tive oportunidade de experimentar as tuas dicas. Logo que possa dou-te um feedback. Mas obrigado de qualquer forma pelas sugestões.

Gnrtuga,

Eu sei que está confuso e é apenas provisório, pois como te disse, o código ainda não está completo.

O procedimento que chama N1, está na inputbox que se houver introdução sem carateres, faz repetir o procedimento N1 ou seja

chama de novo a inputbox.

O procedimento NN1 é provisório e só está assim para não me parar o programa com mensagens de erro, pois no futuro será para dizer algo do genero: Se NN1 = false então vai para NN2 e assim sucessivamente, isto porque eu posso querer alterar a informação gravada em NN1 e NN2 sem mecher nas outras.

Eu sei que é complicado estar a olhar para um código provisório, principalmente quando não se sebe exatamente o que se pretende desse código, mas de qualquer forma, obrigado pela analise.

Obrigado pela atenção que dispensas.

Abraços

M.A.

Posted (edited)

Acao.

Depois de inserir o primeiro código que enviaste e ter feito alguns ajustes, verifiquei que funciona na perfeição.

Após os ajustes o código ficou assim:

N1:
Dim NOVODADO As String
NOVODADO = InputBox("" & vbLf & vbLf & "INSIRA O NOVO NOME.", "        ........ALTERAÇÃO DE DADOS........")
   If IsNumeric(NOVODADO) = True And NOVODADO = "" Then
   MsgBox " NÃO ALTERADO", vbCritical
   GoTo N1
   Else
   Label31.Caption = NOVODADO

Dim address As Variant
'alteração efectuada aqui
Dim RangColF As Range
Dim RangRow As Range
Set RangColF = Range("F2:F2000")
For Each RangRow In RangColF.rows
If RangRow.Cells(1, 1) = TextBox1.Text Then
address = RangRow.Cells(1, 0)
'alteração efectuada aqui. Funciona da mesma forma com cells(1,1) e cells(1,0), porquê?
RangRow.Cells(1, 1).Select

MsgBox "   N.I.F.  ENCONTRADO NA CELULA    >    " & Selection.address & vbCrLf _
       & "          REGISTO GRAVADO COM SUCESSO.  "

'aqui movimenta o ponteiro para a coluna pretendida.
ActiveCell.Offset(0, -5).Value = NOVODADO
Exit For
End If
Next

CheckBox1.Value = False
   GoTo NNN
Err:
        MsgBox Err.Description
End If

Agora, é só dar continuidade ao código, em conformidade com as necessidades.

Um grande obrigado aos dois e também ao PaP por permitir estes contactos.

Abraços

M.A.

Edited by thoga31
GeSHi
Posted

boas

If RangRow.Cells(1, 1) = TextBox1.Text Then

address = RangRow.Cells(1, 0)

'alteração efectuada aqui. Funciona da mesma forma com cells(1,1) e cells(1,0), porquê?

verifica que não é a mesma coisa, para selecionar a linha do range e a primeira coluna e (1,1) e com referencia nesta celula movimentas o ponteiro, se quiseres a celula à esquerda é (1,0) que é o caso referido. nota(aqui apenas estamos a selecionar a coluna F mas podeia ser ("F2: J2000")

'aqui movimenta o ponteiro para a coluna pretendida.

ActiveCell.Offset(0, -5).Value = NOVODADO

aqui altera para : «RangRow.Cells(1, -4).value = Novodado» ou algo parecido conforme as necessidades.

assim mesmo que seleciones outra celula com o rato o destino é sempre a celula pretendida.

cumps

acao

Posted

Acao.

Com a rotina que enviaste, a aplicação funciona na perfeição. Tudo o que é exigido da aplicação ela faz como se pretende.

Funciona em pleno.

Bem quase, mas isso é assunto para outro tópico que não se enquadra neste.

Agradecimentos para ti e Gnrtuga.

M.A.

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.