Somar Nomes Listbox

[joseA]

Permitam-me...

Segue um exemplo com aplicação do controle ListView (ListBox evoluído).

[webmaster]

Colega,

Me perdoe. Realmente havia um erro no código. Segue o mesmo corrigido:

Código: Selecionar todos

Option Explicit
'Autor: Tomás Vásquez
'       www.tomasvasquez.com.br
'       www.tomasvasquez.com.br/blog
'       www.tomasvasquez.com.br/forum
'       www.tomasvasquez.com.br/cursocsharp

Private Const NomePlanilha As String = "Fornecedores"
Private Const LinhaCabecalho As Integer = 1



Private Sub TextBoxFiltro_Change()
    If Me.ComboBoxCampos.ListIndex <> -1 Then
        Call PreencheLista(TextBoxFiltro.Text)
    End If
End Sub

Private Sub UserForm_Initialize()
    Call PreencheCampos
End Sub

Private Sub PreencheCampos()
    Dim ws As Worksheet
    Dim coluna As Integer
    Dim linha As Integer
    Set ws = ThisWorkbook.Worksheets(NomePlanilha)
    coluna = 1
    linha = LinhaCabecalho

    With ws
        While .Cells(linha, coluna).Value <> Empty
            Me.ComboBoxCampos.AddItem .Cells(linha, coluna)
            coluna = coluna + 1
        Wend
    End With
End Sub

Private Sub PreencheCabecalho(ByRef Lista())
    Dim ws As Worksheet
    Dim coluna As Integer
    Dim linha As Integer
    Set ws = ThisWorkbook.Worksheets(NomePlanilha)
    coluna = 1
    linha = LinhaCabecalho

    With ws
        While .Cells(linha, coluna).Value <> Empty
            Lista(coluna - 1, 0) = .Cells(linha, coluna)
            coluna = coluna + 1
        Wend
    End With
End Sub

Private Sub PreencheLista(ByVal TextoDigitado As String)
    Dim ws As Worksheet
    Dim i As Integer
    Dim x As Integer
    Dim indiceLista As Integer
    Dim coluna As Integer
    Dim TextoCelula As String
    Set ws = ThisWorkbook.Worksheets(NomePlanilha)
    Dim Lista()

    ReDim Lista(ws.UsedRange.Columns.Count, 0)

    i = LinhaCabecalho + 1
    indiceLista = 1
    coluna = Me.ComboBoxCampos.ListIndex + 1
    Call PreencheCabecalho(Lista)

    ListBoxLista.Clear
    With ws
        While .Cells(i, coluna).Value <> Empty
            TextoCelula = .Cells(i, coluna).Value
            If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then

                For x = 0 To ws.UsedRange.Columns.Count - 1
                    ReDim Preserve Lista(ws.UsedRange.Columns.Count, indiceLista)
                    Lista(x, indiceLista) = .Cells(i, x + 1)
                Next

                indiceLista = indiceLista + 1
            End If
            i = i + 1
        Wend
    End With
    
    Lista = Array2DTranspose(Lista)

    Me.ListBoxLista.List = Lista
End Sub

Private Sub BtSomar_Click()
    If ListBoxLista.ListCount <= 0 Then
        TextBox1 = ListBoxLista.ListCount
    Else
        TextBox1 = ListBoxLista.ListCount - 1
    End If
End Sub

Function Array2DTranspose(avValues As Variant) As Variant
    Dim lThisCol As Long, lThisRow As Long
    Dim lUb2 As Long, lLb2 As Long
    Dim lUb1 As Long, lLb1 As Long
    Dim avTransposed As Variant
    If IsArray(avValues) Then
        On Error GoTo ErrFailed
        lUb2 = UBound(avValues, 2)
        lLb2 = LBound(avValues, 2)
        lUb1 = UBound(avValues, 1)
        lLb1 = LBound(avValues, 1)
        ReDim avTransposed(lLb2 To lUb2, lLb1 To lUb1)
        For lThisCol = lLb1 To lUb1
            For lThisRow = lLb2 To lUb2
                avTransposed(lThisRow, lThisCol) = avValues(lThisCol, lThisRow)
            Next
        Next
    End If
    Array2DTranspose = avTransposed
    Exit Function
ErrFailed:
    Debug.Print Err.Description
    Debug.Assert False
    Array2DTranspose = Empty
    Exit Function
    Resume
End Function

Foi preciso acrescentar a função Array2DTranspose. Mais informações:

http://www.tomasvasquez.com.br/blog/mic ... as-colunas

Abraços

[zootec]

Tomás,

É exatamente o que queria, valeu pela dica.

Cara a planilha Filtro.Listview.vba.custom, também é muito boa.

Um abraço

[gretelferraz]

Oi Gostaria de ajuda para fazer com que este sistema de pesquisa pesquisasse o valor inserido caso outro valor fosse igual ao inserido em outra textbox, o sistema de pesquisa da planilha modelo de cadastro faz assim, porém nela ele diferencia maiúsculas e minusculas, alguém poderia me ajudar a fazer ou o modelo de cadastro pesquisar mesmo que maiusculas e minusculas estejam diferentes, ou ajudar a fazer com que o sistema de pesquisa essa página me retornem o valor se as duas variaveis conferirem?


Grata

[webmaster]

Colega,

Troque a Sub "TextBoxFiltro_Change" por isto:

Código: Selecionar todos

Private Sub TextBoxFiltro_Change()
    If Me.ComboBoxCampos.ListIndex = -1 Then
        MsgBox "Selecione um Campo.", 64, "Treino Listview"
        Me.TextBoxFiltro = ""
        Exit Sub
    End If

    Dim strObjetoBuscar As String
    Dim lngResultado As Long
    'Dim lngColumna As Long, lngFila As Long
    Dim a As Integer
    Dim coluna
    coluna = Me.ComboBoxCampos.ListIndex + 1
    ListView1.ListItems.Clear
    strObjetoBuscar = TextBoxFiltro.Value
    If strObjetoBuscar = "" Then GoTo 99
    strObjetoBuscar = strObjetoBuscar
    For a = 2 To 2010
        lngResultado = InStr(1, PlanFornecedores.Cells(a, coluna), strObjetoBuscar)
        If lngResultado > 0 Then
            Set li = ListView1.ListItems.Add(Text:=Format(PlanFornecedores.Range("A" & a).Value, "00"))
            li.ListSubItems.Add Text:=PlanFornecedores.Range("B" & a).Value
            li.ListSubItems.Add Text:=PlanFornecedores.Range("C" & a).Value
            li.ListSubItems.Add Text:=PlanFornecedores.Range("D" & a).Value
            li.ListSubItems.Add Text:=PlanFornecedores.Range("E" & a).Value
            li.ListSubItems.Add Text:=PlanFornecedores.Range("F" & a).Value
            li.ListSubItems.Add Text:=PlanFornecedores.Range("G" & a).Value
            li.ListSubItems.Add Text:=PlanFornecedores.Range("H" & a).Value
            li.ListSubItems.Add Text:=PlanFornecedores.Range("I" & a).Value
            li.ListSubItems.Add Text:=PlanFornecedores.Range("J" & a).Value
            li.ListSubItems.Add Text:=PlanFornecedores.Range("K" & a).Value
            li.ListSubItems.Add Text:=PlanFornecedores.Range("L" & a).Value
        End If
    Next a
99:
    Me.Label2.Caption = Format(ListView1.ListItems.Count, "00")
End Sub|

Deve funcionar.

Abraços

[luis.ffn]

Gostaria de saber se nesta planilha, a informação que você optou fica em um célula do excel ?

Grato,
Luis

[narsi]

Boa noite a todos!

Vejo que o tópico é antigo, mas o modelo postado por JoseA atende perfeitamente ao que estava procurando.

Se não for pedir muito, poderiam me ajudar a fazer uma alteração?

Quando eu informo uma dado para filtrar e depois eu resolvo apagar a informação, teria como o ListView voltar a ser preenchido com todas as informações da planilha?

Já tentei fazer isso mas não consegui.

Desde já muito obrigado.