[Resolvido] Capturar endereço de uma célula no range F2:F2000

[manuel antonio]

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

[Gnrtuga]

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 February 7, 2013 at 05:57 PM by Gnrtuga

[manuel antonio]

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 February 7, 2013 at 10:36 PM by manuel antonio

[Gnrtuga]

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 February 8, 2013 at 12:02 PM by Gnrtuga

[manuel antonio]

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 February 8, 2013 at 08:16 PM by thoga31
GeSHi

[manuel antonio]

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 February 8, 2013 at 08:16 PM by thoga31
GeSHi

[Gnrtuga]

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 February 8, 2013 at 08:12 PM by Gnrtuga

[acao]

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 February 8, 2013 at 11:32 PM by acao

[manuel antonio]

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.

[manuel antonio]

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 February 9, 2013 at 10:25 PM by thoga31
GeSHi

[acao]

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 February 10, 2013 at 03:01 PM by acao

[Gnrtuga]

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?

[manuel antonio]

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.

[manuel antonio]

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 February 11, 2013 at 07:57 PM by thoga31
GeSHi

[acao]

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

[manuel antonio]

Acao.

Obrigado pela sugestão e pela informação dadas.

Portanto « cells (1,1)», refere-se apenas à primeira linha e à primeira coluna do range seleccionado e não da folha de cálculo, é isso?

abraço

M.A.

[acao]

boas

sim é a celula selecionada, ou seja 1,1 é sempre a primeira celula da linha do range que estamos a selecionar no foreach.

cumps

acao

[manuel antonio]

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.