none
For para preencher lista combobox RRS feed

  • Pergunta

  • Boa tarde a todos, venho aqui novamente aproveitar do conhecimento da comunidade para me ajudar nessa.

    A situação é a seguinte:

    Tenho um formulário onde possuo os seguintes controles:

    - 4 textbox e um combobox.

    Estou querendo preencher a lista de itens deste combobox de acordo com o digitado no textbox.
    Cada textbox possui a seguinte linha:

    Private Sub TextBox9_Change()
        If Len(TextBox9.Value) = 2 Then
            If TextBox9.Value > 7 Then Exit Sub
            ComboBox2.Clear
            UpdateListDocs
        End If
    End Sub

    E no evento keypress somente limitei a números.

    Ex.:

    Quando eu completar 2 dígitos nesse textbox ele chama a função UpdateListDocs e preenche o combobox, de acordo com os itens encontrados na planilha6 onde tenho os dados com o seguinte formato: 00.00.00.00 Descrição do item;

    Vendo essa necessidade criei esse codigo abaixo que filtra e preenche a lista do combobox

    Public Sub UpdateListDocs() Dim ValorRow, ValorFunc, ValorSubfunc, ValorAtiv, ValorDoc, LastRow As Integer Dim PesqList As String Dim RNG As Range ValorFunc = FormArquivar.TextBox9.Value ValorSubfunc = FormArquivar.TextBox10.Value ValorAtiv = FormArquivar.TextBox11.Value ValorDoc = FormArquivar.TextBox12.Value PesqList = ValorFunc + ValorSubfunc + ValorAtiv + ValorDoc 'formatação da string para localizar na planilha Select Case Len(PesqList) Case 2 Case 4 PesqList = ValorFunc + "." + ValorSubfunc Case 6 PesqList = ValorFunc + "." + ValorSubfunc + "." + ValorAtiv Case 8 PesqList = ValorFunc + "." + ValorSubfunc + "." + ValorAtiv + "." + ValorDoc End Select LastRow = Plan6.Range("A1").End(xlDown).Row If Trim(PesqList) <> "" Then For ValorRow = 1 To LastRow With Plan6.Range("A" & ValorRow & ":A" & LastRow) Set RNG = .Find(What:=PesqList, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ SearchFormat:=True) If Not RNG Is Nothing Then If Left(RNG.Value, Len(PesqList)) = PesqList Then FormArquivar.ComboBox2.AddItem RNG.Value End If End If End With Next End If End Sub

    Ele está funcionando normal porém ela está duplicando registros mesmo limpando a lista. Sei que o possível erro é no for mas não sei como resolver.

    De início tentei colocar essa função diretamente no combobox.change mas não consegui fazer, pois não queria que o usuário digitasse o "ponto" a cada 2 dígitos fora que se pegar todos os dados são 998 linhas ficando uma lista muito extensa. Se alguém puder me ajudar desde já agradeço.

    OBS.:A propriedade MatchEntry = Complete


    Laionel Lellis


    segunda-feira, 24 de novembro de 2014 15:39

Respostas

  • Public Sub UpdateListDocs()
      Dim ValorRow, ValorFunc, ValorSubfunc, ValorAtiv, ValorDoc, LastRow As Integer
      Dim PesqList As String
      Dim RNG As Range
      Dim lCount As Long
      Dim clc As VBA.Collection
      
      ValorFunc = FormArquivar.TextBox9.Value
      ValorSubfunc = FormArquivar.TextBox10.Value
      ValorAtiv = FormArquivar.TextBox11.Value
      ValorDoc = FormArquivar.TextBox12.Value
      
      PesqList = ValorFunc + ValorSubfunc + ValorAtiv + ValorDoc
      'formatação da string para localizar na planilha
      Select Case Len(PesqList)
        Case 2
        Case 4
          PesqList = ValorFunc + "." + ValorSubfunc
        Case 6
          PesqList = ValorFunc + "." + ValorSubfunc + "." + ValorAtiv
        Case 8
          PesqList = ValorFunc + "." + ValorSubfunc + "." + ValorAtiv + "." + ValorDoc
      End Select
      
      LastRow = Plan6.Range("A1").End(xlDown).Row
      
      If Trim(PesqList) <> "" Then
        
        Set clc = New VBA.Collection
        For ValorRow = 1 To LastRow
          With Plan6.Range("A" & ValorRow & ":A" & LastRow)
            Set RNG = .Find(What:=PesqList, _
            After:=.Cells(.Cells.Count), _
            LookIn:=xlValues, _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            SearchFormat:=True)
            If Not RNG Is Nothing Then
              If Left(RNG.Value, Len(PesqList)) = PesqList Then
                On Error Resume Next
                clc.Add CStr(RNG), CStr(RNG)
                On Error GoTo 0
              End If
            End If
          End With
          Next
        End If
        
        For lCount = 1 To clc.Count
          FormArquivar.ComboBox2.AddItem clc(lCount)
        Next lCount
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta Laionel Lellis quarta-feira, 26 de novembro de 2014 11:26
    terça-feira, 25 de novembro de 2014 20:07
    Moderador

Todas as Respostas

  • Boa noite Laionel,

    Se quiser pode me enviar seu projeto para que eu tente lhe ajudar.

    beto.credito@gmail.com

    Abraço!



    Roberto Santos

    segunda-feira, 24 de novembro de 2014 20:33
  • Public Sub UpdateListDocs()
      Dim ValorRow, ValorFunc, ValorSubfunc, ValorAtiv, ValorDoc, LastRow As Integer
      Dim PesqList As String
      Dim RNG As Range
      Dim lCount As Long
      Dim clc As VBA.Collection
      
      ValorFunc = FormArquivar.TextBox9.Value
      ValorSubfunc = FormArquivar.TextBox10.Value
      ValorAtiv = FormArquivar.TextBox11.Value
      ValorDoc = FormArquivar.TextBox12.Value
      
      PesqList = ValorFunc + ValorSubfunc + ValorAtiv + ValorDoc
      'formatação da string para localizar na planilha
      Select Case Len(PesqList)
        Case 2
        Case 4
          PesqList = ValorFunc + "." + ValorSubfunc
        Case 6
          PesqList = ValorFunc + "." + ValorSubfunc + "." + ValorAtiv
        Case 8
          PesqList = ValorFunc + "." + ValorSubfunc + "." + ValorAtiv + "." + ValorDoc
      End Select
      
      LastRow = Plan6.Range("A1").End(xlDown).Row
      
      If Trim(PesqList) <> "" Then
        
        Set clc = New VBA.Collection
        For ValorRow = 1 To LastRow
          With Plan6.Range("A" & ValorRow & ":A" & LastRow)
            Set RNG = .Find(What:=PesqList, _
            After:=.Cells(.Cells.Count), _
            LookIn:=xlValues, _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            SearchFormat:=True)
            If Not RNG Is Nothing Then
              If Left(RNG.Value, Len(PesqList)) = PesqList Then
                On Error Resume Next
                clc.Add CStr(RNG), CStr(RNG)
                On Error GoTo 0
              End If
            End If
          End With
          Next
        End If
        
        For lCount = 1 To clc.Count
          FormArquivar.ComboBox2.AddItem clc(lCount)
        Next lCount
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta Laionel Lellis quarta-feira, 26 de novembro de 2014 11:26
    terça-feira, 25 de novembro de 2014 20:07
    Moderador
  • Muito Obrigado, funcionou certinho.

    Laionel Lellis

    quarta-feira, 26 de novembro de 2014 11:26