none
comando "Buscar" para Userform VBA Excel RRS feed

  • 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

    sexta-feira, 20 de setembro de 2013 23:01

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

    sábado, 21 de setembro de 2013 21:36
    Moderador

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

    sábado, 21 de setembro de 2013 21:36
    Moderador
  • Felipe, muito obrigada pela ajuda, funcionou perfeitamente!! E da próxima vez vou inserir os blocos de código.

    abraços.

    domingo, 22 de setembro de 2013 07:24