Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Juntar e Somar
 
Notifications
Clear all

Juntar e Somar

 
2024 - VBA & Macros
Post Recente por FAGNERIBAS 6 anos atrás
8 Posts
4 Usuários
0 Reactions
2,251 Visualizações
RSS
 Luk
(@luk)
Posts: 44
Eminent Member
Topic starter
 

Bom dia, pessoal!

Estou usando vba com bd access, e gostaria de somar os dados da listview da seguinte forma:

Ao fazer filtro na listview1 ele agrupar os valores das descrições iguais, e somar o resultado, Exemplo:

Cartão de credito 250,00
boleto 100,00
cheque 50,00
cartão de credito 250,00
boleto 50,00

então na listview2, somar exemplo:
2 cartão de credito 500,00
2 boleto 150,00
1 cheque 50,00

>>>> tentei usar o DISTINCT e o GROUP eles até funcionam para o banco de dados, mas para a Listview não deu muito certo, não posso fazer pelo banco porque quero que forme grupo somente do que filtrar na listviw1

exemplo de códigos que tentei usar

      Dim Valor As Double
      ListView2.ListItems.Clear
      If ListView1.ListItems.Count = 0 Then Exit Sub
      Dim i As Integer
      ConnectDB
         rs.Open "Select DISTINCT (FormaPgto) from Tb7FormaPgto", db, 2, 3
            Do Until rs.EOF
               For i = 1 To ListView1.ListItems.Count
                  If ListView1.ListItems(i).SubItems(6) = rs(0) Then
                     Set Item = ListView2.ListItems.Add(, , rs(0))
                     Valor = Valor + (ListView1.ListItems(i).ListSubItems(5))
                  End If
               Next
               Item.SubItems(1) = Format(Valor, "#,##0.00")
               Valor = 0
               rs.MoveNext
            Loop
      FechaDB
 
Postado : 22/12/2017 7:56 am
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 

https://www.youtube.com/results?search_query=vba+soma+listview
https://www.youtube.com/results?search_query=vba+soma+listbox

 
Postado : 22/12/2017 8:06 am
 Luk
(@luk)
Posts: 44
Eminent Member
Topic starter
 

obrigado por me enviar estes links, até já tinha visto, não queria simplesmente, somar as colunas,
eu quero juntar as descrições na listview2 com a soma das descrições. Exemplo: se no meu filtro tiver cartão de credito em 1000x quero que ele carregue na listview2 uma unica vez com o total da soma, não sei se consegui me expressar,

 
Postado : 22/12/2017 8:11 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Luk ,

Bom dia!

Anexe seu arquivo compactado com .ZIP. Isso facilitará a resposta que sairá bem mais rápida.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 22/12/2017 9:00 am
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 
Option Explicit



Private Sub UserForm_Initialize()
    
'CONFIGURA A LISTBOX PARA DUAS COLUNAS
    Me.ListBox1.ColumnCount = 2
    'DECLARA AS MATRIZES QUE VÃO GUARDAR OS VALORES NA MEMÓRIA
    Dim ListaString(1 To 100, 1 To 2) As String
    Dim ListaValor(1 To 100) As Double
    'VARIÁVEIS PARA OS LAÇOS DE REPETIÇÃO
    Dim linha As Long
    Dim i, j, k As Long
   'A PARTIR DA LINHA 1
    linha = 1
    
    'PERCORRE A COLUNA 1 DA PLANILHA
    'PARA DESCOBRIR QUANTAS LINHAS ESTÃO PREENCHIDAS
    While ThisWorkbook.Sheets("Planilha1").Cells(linha, 1).Value <> ""
        
        
        
        linha = linha + 1
        
    Wend
    'PREENCHE A MATRIZ COM OS DADOS DA PLANILHA
    For i = 1 To linha - 1
        ListaString(i, 1) = ThisWorkbook.Sheets("Planilha1").Cells(i, 1).Value
        ListaString(i, 2) = ThisWorkbook.Sheets("Planilha1").Cells(i, 2).Value
    Next i
    'PERCORRE A MATRIZ PARA EFETUAR A SOMA
    For i = 1 To linha - 2
        
        For j = i + 1 To linha - 1
            'SE O VALOR DA LINHA ABAIXO
            'FOR IGUAL AO VALOR DA LINHA ACIMA
            If ListaString(j, 1) = ListaString(i, 1) Then

                'PREENCHE AS MATRIZES COM AS SOMAS
                ListaValor(i) = CDbl(ListaString(i, 2)) + CDbl(ThisWorkbook.Sheets("Planilha1").Cells(j, 2).Value)
                ListaString(i, 2) = CStr(ListaValor(i))
                
            End If
            
        Next j
        
    Next i
    
    
    'PERCORRE A MATRIZ PARA ENCONTRAR VALORES REPETIDOS
    For k = 1 To linha - 2
    For j = k + 1 To linha - 1
    'SE O VALOR FOR REPETIDO
        If ListaString(k, 1) = ListaString(j, 1) Then
          'APAGA O VALOR ABAIXO
            ListaString(j, 1) = ""
            ListaString(j, 2) = ""
        End If
        Next j
    Next k
    'COLOCA A MATRIZ NA LISTBOX
    Me.ListBox1.List = ListaString
    
    
End Sub
 
Postado : 22/12/2017 11:21 am
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 

Trabalho enorme. Espero que você reconheça.


Option Explicit



Private Sub ComboBox1_Change()
    'SE HOUVER ITEM SELECIONADO NA COMBOBOX
    If ComboBox1.ListIndex >= 0 Then
        'CONFIGURA A LISTBOX PARA DUAS COLUNAS
        Me.ListBox1.ColumnCount = 2
        
        'LIMPA A LISTBOX
        Me.ListBox1.Clear
        'DECLARA AS MATRIZES QUE VÃO GUARDAR OS VALORES NA MEMÓRIA
        Dim LISTASTRING(1 To 100, 1 To 2) As String
        Dim ListaValor(1 To 100) As Double
        'VARIÁVEIS PARA OS LAÇOS DE REPETIÇÃO
        Dim linha As Long
        Dim i, j, k As Long
        'A PARTIR DA LINHA 1
        linha = 1
        
        'PERCORRE A COLUNA 1 DA PLANILHA
        'PARA DESCOBRIR QUANTAS LINHAS ESTÃO PREENCHIDAS
        While ThisWorkbook.Sheets("Planilha1").Cells(linha, 1).Value <> ""
            
            
            
            linha = linha + 1
            
        Wend
        
        
        'PREENCHE A MATRIZ COM OS DADOS DA PLANILHA
        For i = 1 To linha - 1
            
            LISTASTRING(i, 1) = ThisWorkbook.Sheets("Planilha1").Cells(i, 1).Value
            LISTASTRING(i, 2) = ThisWorkbook.Sheets("Planilha1").Cells(i, 2).Value
        Next i
        'PERCORRE A MATRIZ PARA EFETUAR A SOMA
        For i = 1 To linha - 2
            
            For j = i + 1 To linha - 1
                'SE O VALOR DA LINHA ABAIXO
                'FOR IGUAL AO VALOR DA LINHA ACIMA
                If LISTASTRING(j, 1) = LISTASTRING(i, 1) Then
                    On Error Resume Next
                    'PREENCHE AS MATRIZES COM AS SOMAS
                    ListaValor(i) = CDbl(LISTASTRING(i, 2)) + CDbl(ThisWorkbook.Sheets("Planilha1").Cells(j, 2).Value)
                    LISTASTRING(i, 2) = CStr(ListaValor(i))
                    
                End If
                
            Next j
            
        Next i
        
        
        'PERCORRE A MATRIZ PARA ENCONTRAR VALORES REPETIDOS
        For k = 1 To linha - 2
            For j = k + 1 To linha - 1
                'SE O VALOR FOR REPETIDO
                If LISTASTRING(k, 1) = LISTASTRING(j, 1) Then
                    'APAGA O VALOR ABAIXO
                    LISTASTRING(j, 1) = ""
                    LISTASTRING(j, 2) = ""
                End If
            Next j
        Next k
        
        
        'PERCORRE A MATRIZ PARA APAGAR VALORES NÃO CORRESPONDENTES
        For k = 1 To linha - 2
            'SE O VALOR FOR REPETIDO
            If LISTASTRING(k, 1) <> Me.ComboBox1.Value Then
                'APAGA O VALOR ABAIXO
                LISTASTRING(k, 1) = ""
                LISTASTRING(k, 2) = ""
            End If
        Next k
        
        'SE O VALOR DA COLUNA 1 DA PLANILHA
        'FOR IGUAL AO VALOR SELECIONADO NA COMBOBOX
    '    If ThisWorkbook.Sheets("Planilha1").Cells(i, 1).Value = Me.ComboBox1.Value Then
            
            
            'COLOCA A MATRIZ NA LISTBOX
            Me.ListBox1.List = LISTASTRING
            
            'PERCORRE A LISTBOX PARA
            'REMOVER ITENS EM BRANCO
FINAL:
            For i = 0 To Me.ListBox1.ListCount - 1
       '     For j = 0 To Me.ListBox1.ListCount - 1

                If Me.ListBox1.List(i) = "" Then

                    Me.ListBox1.RemoveItem (i)
                    GoTo FINAL
                End If
           '     Next j
            Next i
'        End If
        End If
End Sub

Private Sub UserForm_Initialize()
    Dim LISTASTRING(1 To 100) As String
    Dim linha As Long
    Dim i, j, k As Long
    'A PARTIR DA LINHA 1
    linha = 1
    
    'PERCORRE A COLUNA 1 DA PLANILHA
    'PARA DESCOBRIR QUANTAS LINHAS ESTÃO PREENCHIDAS
    While ThisWorkbook.Sheets("Planilha1").Cells(linha, 1).Value <> ""
        
        
        
        linha = linha + 1
        
    Wend
    'PREENCHE A MATRIZ COM OS DADOS DA PLANILHA
    For i = 1 To linha - 1
        LISTASTRING(i) = ThisWorkbook.Sheets("Planilha1").Cells(i, 1).Value
    Next i
    
    'PERCORRE A MATRIZ PARA ENCONTRAR VALORES REPETIDOS
    For k = 1 To linha - 2
        For j = k + 1 To linha - 1
            'SE O VALOR FOR REPETIDO
            If LISTASTRING(k) = LISTASTRING(j) Then
                'APAGA O VALOR ABAIXO
                LISTASTRING(j) = ""
                LISTASTRING(j) = ""
            End If
        Next j
    Next k
    'COLOCA A MATRIZ NA COMBOBOX
    Me.ComboBox1.List = LISTASTRING
    
End Sub
 
Postado : 22/12/2017 12:31 pm
 Luk
(@luk)
Posts: 44
Eminent Member
Topic starter
 

Amigo, klarc!
Fico feliz que tenha atendido esta minha necessidade, que Deus abençoe, este fórum tem me ajudado muito e são iniciativas como as suas que destacam sua iniciativa de ajudar, muito obrigado!

Testei seu código esta muito bom, parabéns, só vou precisar adaptar porque suponhamos que onde esta a planilha excel, vai estar um listview, porque os dados vão estar de um list para outra...
Exemplo:
do banco de dados Access, vai carregar listview1 na la listview2 vai agrupando as descrições e somando os valores... vou tentar adaptar, caso não consiga peço ajuda novamente,
muito obrigado!

 
Postado : 22/12/2017 1:12 pm
 FAGNERIBAS
(@fagneribas)
Posts: 67
Trusted Member
 

klarc28

Amigo e possível fazer isso meu projeto vba,? porem usando uma outra listview como base e nao a planilha?? irei mandar o meu projeto para vc dar uma olha e me dizer se e possivel. esse e o meu projeto
https://drive.google.com/open?id=18HZYm ... rUl_FtyUy_

 
Postado : 14/05/2018 8:06 am
Forum Jump:
  Tópico Anterior
Próximo Tópico