none
Carregar ListBox RRS feed

  • Pergunta

  • Bom dia,

        Gostaria de um código para carregar Listbox com quatro coluna no evento inicialize, que faça uma pesquisa dos nomes (João, Pedro, Paulo, Marlene e Jose)  toda a coluna B, e carregasse o ListBox com as informações de cada nome, sendo que cada nome são repetida varias vezes no coluna B então ai a necessidade de repetir todos os nomes com as informações. assim, Plan1, a partir da linha 9.

    DATA NOMES HORÁRIO ENTRADA HORÁRIO SAÍDA
    01/05/2015 JOÃO 09:00 18:00
    02/05/2015 MIGUEL 08:00 14:00
    03/05/2015 PEDRO 10:00 18:00
    04/05/2015 PAULO 08:00 12:00
    05/05/2015 JOSE 09:00 18:00
    06/05/2015 MARCOS 08:00 16:00
    07/05/2015 FELIPE 08:30 18:00
    08/05/2015 JOÃO 08:00 11:00
    09/05/2015 PEDRO 08:20 18:00
    10/05/2015 MARLENE 08:00 15:00
    11/05/2015 LOPES 08:40 18:00
    12/05/2015 SANDRO 08:00 13:00


    domingo, 31 de maio de 2015 13:08

Respostas

  • tenta assim Marcelo:

        Dim b As Worksheet
        Dim l As MSForms.ListBox
        Dim arrPesquisa() As String
        
        Set l = ListBox1
        Set b = ThisWorkbook.Sheets("Plan1")
        
        
        l.ColumnCount = 4
        arrPesquisa = Split("João;Pedro;Paulo;Marlene;Jose", ";")
        
        'Criar o cabeçalho
        l.AddItem "Data"
        l.List(l.ListCount - 1, 1) = "Nome"
        l.List(l.ListCount - 1, 2) = "Entrada"
        l.List(l.ListCount - 1, 3) = "Saida"
        
        'Passa por todos os itens
        y = b.Range("A1048576").End(xlUp).Row
        
        For x = 9 To y
            
            For i = LBound(arrPesquisa) To UBound(arrPesquisa) - 1
                
                If UCase(b.Cells(x, 2).Value) Like "*" & UCase(arrPesquisa(i)) & "*" Then
                    
                    l.AddItem b.Cells(x, 1).Value
                    l.List(l.ListCount - 1, 1) = b.Cells(x, 2).Value
                    l.List(l.ListCount - 1, 2) = b.Cells(x, 3).Text
                    l.List(l.ListCount - 1, 3) = b.Cells(x, 4).Text
                        
                End If
                
            Next i
        
        Next x


    Natan

    • Marcado como Resposta Marcelo Torre domingo, 31 de maio de 2015 18:00
    domingo, 31 de maio de 2015 16:16

Todas as Respostas

  • tenta assim Marcelo:

        Dim b As Worksheet
        Dim l As MSForms.ListBox
        Dim arrPesquisa() As String
        
        Set l = ListBox1
        Set b = ThisWorkbook.Sheets("Plan1")
        
        
        l.ColumnCount = 4
        arrPesquisa = Split("João;Pedro;Paulo;Marlene;Jose", ";")
        
        'Criar o cabeçalho
        l.AddItem "Data"
        l.List(l.ListCount - 1, 1) = "Nome"
        l.List(l.ListCount - 1, 2) = "Entrada"
        l.List(l.ListCount - 1, 3) = "Saida"
        
        'Passa por todos os itens
        y = b.Range("A1048576").End(xlUp).Row
        
        For x = 9 To y
            
            For i = LBound(arrPesquisa) To UBound(arrPesquisa) - 1
                
                If UCase(b.Cells(x, 2).Value) Like "*" & UCase(arrPesquisa(i)) & "*" Then
                    
                    l.AddItem b.Cells(x, 1).Value
                    l.List(l.ListCount - 1, 1) = b.Cells(x, 2).Value
                    l.List(l.ListCount - 1, 2) = b.Cells(x, 3).Text
                    l.List(l.ListCount - 1, 3) = b.Cells(x, 4).Text
                        
                End If
                
            Next i
        
        Next x


    Natan

    • Marcado como Resposta Marcelo Torre domingo, 31 de maio de 2015 18:00
    domingo, 31 de maio de 2015 16:16
  • Isso, obrigado Natan Silva.
    domingo, 31 de maio de 2015 18:01