Usuário com melhor resposta
comando "Buscar" para Userform VBA Excel

Pergunta
-
Boa noite, Eu criei um botao para buscar dados no meu userform. Caso o registro tenha sido excluido (qndo eu excluo ele nao deleta a linha, somente registra "excluido" na coluna Status), deve aparecer uma msgbox "Cliente não encontrado".
A busca funciona, mas a mensagem "Cliente nao encontrado" aparece em todas as buscas.
Quando o cliente foi excluido, a msgbox funciona corretamente. No entanto, quando o cliente existe (coluna "Status" está em branco), a caixa de mensagem aparece também e os dados aparecem no userform. Alguem pode me indicar o que eu estou comandando errado?
row_number = 1
Do
DoEvents
row_number = row_number + 1
busca_tele1 = Sheets("Clientes").Range("F" & row_number)
busca_excluido = Sheets("Clientes").Range("I" & row_number)
If busca_tele1 = userformcadcli.txttele1.Text And busca_excluido = "" Then
userformcadcli.txtcodcli.Text = Sheets("Clientes").Range("A" & row_number)
userformcadcli.txtnomecli.Text = Sheets("Clientes").Range("B" & row_number)
userformcadcli.txtender.Text = Sheets("Clientes").Range("C" & row_number)
userformcadcli.txtrefer.Text = Sheets("Clientes").Range("D" & row_number)
userformcadcli.ComboBoxbairro.Value = Sheets("Clientes").Range("E" & row_number)
userformcadcli.txttele2.Text = Sheets("Clientes").Range("G" & row_number)
userformcadcli.txtemail.Text = Sheets("Clientes").Range("H" & row_number)
End If
Loop Until Sheets("Clientes").Range("A" & row_number) = ""
If busca_tele1 = userformcadcli.txttele1.Text And busca_excluido <> "" Then
GoTo Warn
End If
Warn:
MsgBox "Cliente nao encontrado!"
txtemail = vbNullString
Exit Sub
End Sub
Respostas
-
Ao inserir um código no fórum, utilize blocos de código. Para utilizar essa ferramenta, clique no botão cuja legenda é “Inserir bloco de código” na barra do editor de mensagens do fórum.
---
Sobre sua dúvida, utilize o código abaixo:
Private Sub CommandButton1_Click() Dim lngRow As Long With ThisWorkbook.Worksheets("Clientes") lngRow = fncMultMatch(Me.txttele1, .Columns("F"), "", .Columns("I")) If lngRow > 0 Then Me.txtcodcli.Text = .Cells(lngRow, "A") Me.txtnomecli.Text = .Cells(lngRow, "B") Me.txtender.Text = .Cells(lngRow, "C") Me.txtrefer.Text = .Cells(lngRow, "D") Me.ComboBoxbairro.Value = .Cells(lngRow, "E") Me.txttele2.Text = .Cells(lngRow, "G") Me.txtemail.Text = .Cells(lngRow, "H") Else MsgBox "Registro não encontrado", vbExclamation End If End With End Sub Function fncMatch(ByVal str As String, ByVal varVetor As Variant) As Long Dim Temp As Long On Error Resume Next Temp = WorksheetFunction.Match(str + 0, varVetor, 0) If Temp = 0 Then Temp = WorksheetFunction.Match(CStr(str), varVetor, 0) fncMatch = Temp End Function Function fncMultMatch(ParamArray avar()) As Long Dim blnMatch As Boolean Dim lng As Long Dim lngCol As Long Dim lngMatch As Long Dim lngTotal As Long Dim rng As Range Dim wks As Worksheet lngTotal = Application.WorksheetFunction.CountIf(avar(1), avar(0)) If lngTotal = 0 Then Exit Function End If ReDim alngTemp(1 To lngTotal) Set rng = avar(1) Set wks = rng.Parent For lng = 1 To lngTotal lngMatch = fncMatch(avar(0), rng) For lngCol = 2 To UBound(avar) Step 2 blnMatch = True If wks.Cells(lngMatch, avar(lngCol + 1).Column) <> avar(lngCol) Then blnMatch = False Exit For End If Next lngCol If blnMatch = True Then fncMultMatch = lngMatch Exit Function End If If rng.Rows.Count - lngMatch + rng(1).Row - 1 > 0 Then Set rng = rng.Resize(rng.Rows.Count - lngMatch + rng(1).Row - 1).Offset(lngMatch - rng(1).Row + 1) End If Next lng End Function
Felipe Costa Gualberto - http://www.ambienteoffice.com.br
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 19:20
Todas as Respostas
-
Ao inserir um código no fórum, utilize blocos de código. Para utilizar essa ferramenta, clique no botão cuja legenda é “Inserir bloco de código” na barra do editor de mensagens do fórum.
---
Sobre sua dúvida, utilize o código abaixo:
Private Sub CommandButton1_Click() Dim lngRow As Long With ThisWorkbook.Worksheets("Clientes") lngRow = fncMultMatch(Me.txttele1, .Columns("F"), "", .Columns("I")) If lngRow > 0 Then Me.txtcodcli.Text = .Cells(lngRow, "A") Me.txtnomecli.Text = .Cells(lngRow, "B") Me.txtender.Text = .Cells(lngRow, "C") Me.txtrefer.Text = .Cells(lngRow, "D") Me.ComboBoxbairro.Value = .Cells(lngRow, "E") Me.txttele2.Text = .Cells(lngRow, "G") Me.txtemail.Text = .Cells(lngRow, "H") Else MsgBox "Registro não encontrado", vbExclamation End If End With End Sub Function fncMatch(ByVal str As String, ByVal varVetor As Variant) As Long Dim Temp As Long On Error Resume Next Temp = WorksheetFunction.Match(str + 0, varVetor, 0) If Temp = 0 Then Temp = WorksheetFunction.Match(CStr(str), varVetor, 0) fncMatch = Temp End Function Function fncMultMatch(ParamArray avar()) As Long Dim blnMatch As Boolean Dim lng As Long Dim lngCol As Long Dim lngMatch As Long Dim lngTotal As Long Dim rng As Range Dim wks As Worksheet lngTotal = Application.WorksheetFunction.CountIf(avar(1), avar(0)) If lngTotal = 0 Then Exit Function End If ReDim alngTemp(1 To lngTotal) Set rng = avar(1) Set wks = rng.Parent For lng = 1 To lngTotal lngMatch = fncMatch(avar(0), rng) For lngCol = 2 To UBound(avar) Step 2 blnMatch = True If wks.Cells(lngMatch, avar(lngCol + 1).Column) <> avar(lngCol) Then blnMatch = False Exit For End If Next lngCol If blnMatch = True Then fncMultMatch = lngMatch Exit Function End If If rng.Rows.Count - lngMatch + rng(1).Row - 1 > 0 Then Set rng = rng.Resize(rng.Rows.Count - lngMatch + rng(1).Row - 1).Offset(lngMatch - rng(1).Row + 1) End If Next lng End Function
Felipe Costa Gualberto - http://www.ambienteoffice.com.br
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 19:20
-