Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Pesquisa em ListVie...
 
Notifications
Clear all

Pesquisa em ListView !

 
2024 - VBA & Macros
Post Recente por Erwin 9 anos atrás
7 Posts
2 Usuários
0 Reactions
827 Visualizações
RSS
 Erwin
(@erwin)
Posts: 0
New Member
Topic starter
 

Muito Boa Tarde !

Preciso de uma ajuda dos amigos, conforme abaixo;

Tenho no exemplo em anexo uma planilha com um formulário que possui um TextBox 1 e dois ListView 1 e 2.
tem uma rotina que preenche o ListView 1 com determinados dados da planilha no evento UserForm_Inicialize(),
e tem uma outra rotina que faz a busca por dados na planilha no evento TextBox1_Change(), ambas rotinas estão funcionado corretamente,
porém eu preciso de uma rotina que, no evento IntenClick do ListView 1 me retorne no ListView 2 os dados que estão ao lado
dos dados da pesquisa na planilha (na planilha esses dados estão marcados como "Cor"), alguém tem uma solução para mim, já procurei bastante
na internet mas não estou encontrando uma rotina que eu possa adaptar para meu caso, abraços.

Att,
Erwin Guilherme Stein

 
Postado : 15/09/2015 1:01 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Erwin, não sei o porque mas seu modelo me da mensagem de erros e não consigo executar as macros, talvez por questão de versão, eu utilizo a v 2007.

Mas independente disto, deu para ler as rotinas e se entendi corretamente, faça as seguintes alterações.

Estou supondo que em seu formulário tem os dois Listview, se não tiver acrescente outro listview e tenha certeza que o mesmo está com o nome de ListView2

Private Sub UserForm_Initialize()
    PreencherListView
    PreencherListView2
    Me.TextBox1.SetFocus
End Sub

Cria somente a coluna no listview2, se não quiser executar esta rotina, voce pode definir diretamente na propriedade

Sub PreencherListView2()
   
   With ListView2
        .ColumnHeaders.Clear
        .Gridlines = True
        .View = lvwReport
        .ColumnHeaders.Add Text:="COR", Width:=50
        .Gridlines = True
    End With
End Sub

Troque sua rotina por esta que preenche o Listview2:

Private Sub Procura_Descricao_Tecido()
    Dim strObjetoBuscar As String
    Dim lngResultado, lastRow As Long
    'Dim lngColumna As Long, lngFila As Long
    Dim a As Integer
    Dim coluna
    coluna = 1
    ListView1.ListItems.Clear
    ListView2.ListItems.Clear
    strObjetoBuscar = TextBox1.Value
    
    strObjetoBuscar = LCase(strObjetoBuscar)
    
    lastRow = Plan2.Cells(Plan2.Cells.Rows.Count, "a").End(xlUp).Row

    For a = 2 To lastRow
        lngResultado = InStr(1, Plan2.Cells(a, coluna), strObjetoBuscar, vbTextCompare)
            If lngResultado > 0 Then
        
            Set li = ListView1.ListItems.Add(Text:=Plan2.Range("A" & a).Value)
                 li.ListSubItems.Add Text:=Format(Plan2.Range("B" & a).Value, "0.00")
                 li.ListSubItems.Add Text:=Format(Plan2.Range("C" & a).Value, "currency")
                 li.ListSubItems.Add Text:=Format(Plan2.Range("D" & a).Value, "currency")
            
           'PREENCHE O LISTVIEW2
           ListView2.ListItems.Add Text:=Plan2.Range("E" & a).Value
           ListView2.ListItems.Add Text:=Plan2.Range("F" & a).Value
           ListView2.ListItems.Add Text:=Plan2.Range("G" & a).Value
           ListView2.ListItems.Add Text:=Plan2.Range("H" & a).Value
           
            End If
    Next a
    
End Sub

Não pude testar, então teste e qualquer duvida retorne.

[]s

 
Postado : 15/09/2015 6:10 pm
 Erwin
(@erwin)
Posts: 0
New Member
Topic starter
 

Bom dia Mauro, muito obrigado ! me atende perfeitamente essa rotina.

 
Postado : 16/09/2015 7:12 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Tópico Destrancado e setado como nao resolvido a pedido do solicitante.

 
Postado : 21/09/2015 11:30 am
 Erwin
(@erwin)
Posts: 0
New Member
Topic starter
 

Oi Mauro, adaptei meu código ao seu e deu certo ficou bem legal, porém surgiu outra dúvida...
abaixo...
Tenho dois produtos, um com uma única cor e outro com vinte corres, se eu deixar o código do jeito que está, vai aparecer no ListView2
vinte linhas mesmo que em branco, então se eu ordenar o ListView (.Sorted = True, .SortKey = 0) aparecem primeiro as linhas em branco
deste produto que tem apenas uma cor (ficando desorganizado no listview), gostaria que da mesma forma que o código pega os dados da planinha pelo
"lastRow = Plan5.Cells(Plan5.Cells.Rows.Count, "A").End(xlUp).Row" também pegasse por um "lastCol", pegando todos os dados da
coluna "F" até (xlToRight) (à partir da coluna F até onde existir dados), não estou conseguindo adpatar...

Esse é o código que eu quero adapatar.... (Anexo o arquivo)

Private Sub Procura_Cor_VerticalTecido()
    Dim strObjetoBuscar As String
    Dim lngResultado, lastRow As Long
    'Dim lngColumna As Long, lngFila As Long
    Dim a As Integer
    Dim coluna
    coluna = 1
    ListView1.ListItems.Clear
    ListView2.ListItems.Clear
    strObjetoBuscar = TextBox1.Value
    
    strObjetoBuscar = LCase(strObjetoBuscar)
    
    lastRow = Plan5.Cells(Plan5.Cells.Rows.Count, "a").End(xlUp).Row

    For a = 2 To lastRow
        lngResultado = InStr(1, Plan5.Cells(a, coluna), strObjetoBuscar, vbTextCompare)
            If lngResultado > 0 Then
        
            Set li = ListView1.ListItems.Add(Text:=Plan5.Range("A" & a).Value)
                 li.ListSubItems.Add Text:=Format(Plan5.Range("C" & a).Value, "currency")
                 li.ListSubItems.Add Text:=Format(Plan5.Range("D" & a).Value, "currency")
            
           'PREENCHE O LISTVIEW2
           ListView2.ListItems.Add Text:=Plan5.Range("F" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("G" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("H" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("I" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("J" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("K" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("L" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("M" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("N" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("O" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("P" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("Q" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("R" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("S" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("T" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("U" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("V" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("W" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("X" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("Y" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("Z" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("AA" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("AB" & a).Value
           ListView2.ListItems.Add Text:=Plan5.Range("AC" & a).Value


           
            End If
    Next a

End Sub
 
Postado : 22/09/2015 7:44 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Erwin, veja se é isto e depois ajuste as outras rotinas.

Private Sub Procura_Cor_VerticalTecido()
    Dim strObjetoBuscar As String
    Dim lngResultado, Lastrow As Long
    Dim a As Integer
    Dim coluna
    coluna = 1
    
    Dim LastCol 'Ultima coluna com dados
    Dim sColIni 'Coluna Inicial
    sColIni = 6 'Definimos a coluna Inicio 6 (F)

    
    ListView1.ListItems.Clear
    ListView2.ListItems.Clear
    strObjetoBuscar = TextBox1.Value
    
    strObjetoBuscar = LCase(strObjetoBuscar)
    
    Lastrow = Plan5.Cells(Plan5.Cells.Rows.Count, "a").End(xlUp).Row

    For a = 2 To Lastrow
        
        lngResultado = InStr(1, Plan5.Cells(a, coluna), strObjetoBuscar, vbTextCompare)
            
            If lngResultado > 0 Then
                
                LastCol = Plan5.Cells(a, Columns.Count).End(xlToLeft).Column 'Capturamos a ultima coluna com dados
            
                Set li = ListView1.ListItems.Add(Text:=Plan5.Range("A" & a).Value)
                     li.ListSubItems.Add Text:=Format(Plan5.Range("C" & a).Value, "currency")
                     li.ListSubItems.Add Text:=Format(Plan5.Range("D" & a).Value, "currency")
            
                'PREENCHE O LISTVIEW2
                For sx = sColIni To LastCol
                    ListView2.ListItems.Add Text:=Plan5.Cells(a, sColIni).Value
                    sColIni = sColIni + 1
                Next sx

            End If
    Next a

End Sub

[]s

 
Postado : 22/09/2015 7:48 pm
 Erwin
(@erwin)
Posts: 0
New Member
Topic starter
 

Mauro, show !!!!!! isso mesmo, muito obrigado.

 
Postado : 23/09/2015 7:52 am
Forum Jump:
  Tópico Anterior
Próximo Tópico