ATENÇÃO NOVOS USUÁRIOS

Se registrou recentemente? Seu cadastro será avaliado e mendiante aprovação, a conta será ativada e você poderá usufruir do fórum. O tempo de avaliação gira em torno de 24 a 48 horas.

Esqueceu sua senha?

Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

Somar Nomes Listbox

Perguntas e Repostas sobre os artigos, posts e arquivos que são postados no site
Avatar do usuário
joseA
Jedi
Jedi
Mensagens: 1008
Registrado em: Qui Out 22, 2009 7:22 am
Localização: Cel. Fabriciano - MG

Re: Somar Nomes Listbox

Mensagem por joseA » Seg Jul 05, 2010 7:18 pm

:shock:

Permitam-me...

Segue um exemplo com aplicação do controle ListView (ListBox evoluído).
Anexos
Filtra_ListView_VBA_Custom.zip
Atualizado em 14/11/2011
(32.2 KiB) Baixado 1700 vezes
Editado pela última vez por joseA em Seg Nov 14, 2011 1:29 pm, em um total de 1 vez.


Se o post lhe agradou clique no sinal de positivo (ao lado de citar).

Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
webmaster
Administrador
Mensagens: 2790
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Somar Nomes Listbox

Mensagem por webmaster » Seg Jul 05, 2010 10:07 pm

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


Tomás
https://www.tomasvasquez.com.br/blog
https://www.tomasvasquez.com.br/cursocsharp
https://twitter.com/tomamais
Se sua dúvida foi solucionada, acrescente [RESOLVIDO] ao título.

zootec
Colaborador
Colaborador
Mensagens: 52
Registrado em: Sex Jul 02, 2010 7:56 am

Re: Somar Nomes Listbox

Mensagem por zootec » Qua Jul 07, 2010 7:29 am

Tomás,

É exatamente o que queria, valeu pela dica.

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

Um abraço



Avatar do usuário
gretelferraz
Acabou de chegar
Acabou de chegar
Mensagens: 5
Registrado em: Sex Mai 11, 2012 2:06 pm

Re: Somar Nomes Listbox

Mensagem por gretelferraz » Sex Mai 11, 2012 2:11 pm

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



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
webmaster
Administrador
Mensagens: 2790
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Somar Nomes Listbox

Mensagem por webmaster » Sex Mai 11, 2012 2:52 pm

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


Tomás
https://www.tomasvasquez.com.br/blog
https://www.tomasvasquez.com.br/cursocsharp
https://twitter.com/tomamais
Se sua dúvida foi solucionada, acrescente [RESOLVIDO] ao título.

luis.ffn
Acabou de chegar
Acabou de chegar
Mensagens: 2
Registrado em: Sex Out 25, 2013 3:01 pm

Re: Somar Nomes Listbox

Mensagem por luis.ffn » Sex Out 25, 2013 3:04 pm

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

Grato,
Luis



narsi
Colaborador
Colaborador
Mensagens: 31
Registrado em: Qui Out 13, 2011 3:56 pm
Localização: Ipatinga / MG

Re: Somar Nomes Listbox

Mensagem por narsi » Ter Mar 25, 2014 7:17 pm

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.



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder