Usuário com melhor resposta
For para preencher lista combobox

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
- Editado Laionel Lellis segunda-feira, 24 de novembro de 2014 15:44
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
Todas as 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
-