Excel vba planilha ListView busca dados soma valores

Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções

Esses procedimentos do Aplicativo Microsoft Excel VBA(visual Basic Application), com auxilio de um objeto ListView busca dados baseados
em determinados critérios e retorna também a soma dos valores Filtrados no objeto ListView, contém folha de planilha para o relatório de
dados filtrados.

Option Explicit
Dim TabelaTemp As Variant
Dim vUltimaLinha As Integer
Dim L As Integer
Dim X As Integer
Dim I As Integer
Dim C As Byte
Dim vLin As Integer
Dim TotalCol As Single

Private Sub CheckBox1_Click()
If frmLANCAMENTOS.CheckBox1.Value = True Then Call AdicionaItem
End Sub

Private Sub cbxAGENCIA_Change()
If frmLANCAMENTOS.CheckBox1.Value = True Then
    Call AdicionaItem
    Exit Sub
End If
If frmLANCAMENTOS.cbxAGENCIA.Value = "" Then Exit Sub
' verifica a combobox lista meses
frmLANCAMENTOS.cbxMESES.Value = ""
' & Se desmarcada, construído de acordo com a agência lista
With Me.ListView1
    .ListItems.Clear
    With .ColumnHeaders
      .Clear
      .Add , , "Data", 50
      .Add , , "Agencia", 70
      .Add , , "Cliente", 95
      .Add , , "Total", 50
    End With
    .FullRowSelect = True
    .Gridlines = True
    .LabelEdit = 1
    .ListItems.Clear
    .View = lvwReport
    With ThisWorkbook.Worksheets("BD")
      .Activate
      vUltimaLinha = .Range("A65535").End(xlUp).Row
      TabelaTemp = .Range(.Cells(2, 1), .Cells(vUltimaLinha, 4)).Value
      .Range("A1").Sort Key1:=.Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
    X = 1
    TotalCol = 0
    For L = 1 To UBound(TabelaTemp, 1)
      If TabelaTemp(L, 2) = Me.cbxAGENCIA.Value Then
        .ListItems.Add , , TabelaTemp(L, 1)
        .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 2)
        .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 3)
        .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 4)
        TotalCol = TotalCol + TabelaTemp(L, 4)
        X = X + 1
      End If
    Next
End With
'TOTAL
Me.TotListView.Value = TotalCol
With Me.txtTotal
       Me.txtTotal = ListView1.ListItems.Count - 0
End With
End Sub

Private Sub cbxMESES_Change()
If frmLANCAMENTOS.CheckBox1.Value = True Then
    Call AdicionaItem
    Exit Sub
End If
If frmLANCAMENTOS.cbxMESES.Value = "" Then Exit Sub
     frmLANCAMENTOS.cbxAGENCIA.Value = ""
' Se desmarcada, construído a lista por MÊS
With Me.ListView1
         .ListItems.Clear
    With .ColumnHeaders
       .Clear
       .Add , , "Data", 50
       .Add , , "Agencia", 70
       .Add , , "Cliente", 95
       .Add , , "Total", 50
    End With
    .FullRowSelect = True
    .Gridlines = True
    .LabelEdit = 1
    .ListItems.Clear
    .View = lvwReport
    With ThisWorkbook.Worksheets("BD")
      .Activate
      vUltimaLinha = .Range("A65535").End(xlUp).Row
      TabelaTemp = .Range(.Cells(2, 1), .Cells(vUltimaLinha, 4)).Value
      .Range("A1").Sort Key1:=.Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
    X = 1
    TotalCol = 0
    For L = 1 To UBound(TabelaTemp, 1)
      If Format(CDate(TabelaTemp(L, 1)), "mmmm") = Me.cbxMESES.Value Then
        .ListItems.Add , , TabelaTemp(L, 1)
        .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 2)
        .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 3)
        .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 4)
        TotalCol = TotalCol + TabelaTemp(L, 4)
        X = X + 1
      End If
    Next L
End With
Me.TotListView.Value = TotalCol
'TOTAL
With Me.txtTotal
     Me.txtTotal = ListView1.ListItems.Count - 0
End With
End Sub

Sub AdicionaItem()
With Me.ListView1
    .ListItems.Clear
    With .ColumnHeaders
      .Clear
      .Add , , "Data", 50
      .Add , , "Agencia", 70
      .Add , , "Cliente", 95
      .Add , , "Total", 50
    End With
    .FullRowSelect = True
    .Gridlines = True
    .LabelEdit = 1
    .ListItems.Clear
    .View = lvwReport
      With ThisWorkbook.Worksheets("BD")
        .Activate
        vUltimaLinha = .Range("A65535").End(xlUp).Row
        TabelaTemp = .Range(.Cells(2, 1), .Cells(vUltimaLinha, 4)).Value
        .Range("A1").Sort Key1:=.Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
      End With
    X = 1
    TotalCol = 0
    For L = 1 To UBound(TabelaTemp, 1)
      If TabelaTemp(L, 2) = Me.cbxAGENCIA.Value Then
        If Format(CDate(TabelaTemp(L, 1)), "mmmm") = Me.cbxMESES.Value Then
          .ListItems.Add , , TabelaTemp(L, 1)
          .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 2)
          .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 3)
          .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 4)
          TotalCol = TotalCol + TabelaTemp(L, 4)
          X = X + 1
        End If
      End If
    Next L
End With
'TOTAL
Me.TotListView.Value = TotalCol
With Me.txtTotal
     Me.txtTotal = ListView1.ListItems.Count - 0
End With
End Sub

Private Sub cmdFECHAR_Click()
Unload Me
End Sub

Private Sub UserForm_initialize()
cbxAGENCIA.RowSource = "Lista!A2: A10"
cbxMESES.RowSource = "Lista!B2: B13"
End Sub

'IMPRESSAO
Private Sub cmdImprimer_Click()
vLin = 1
With Me.ListView1
For I = 1 To .ListItems.Count
vLin = vLin + 1
Sheets("Impressao").Cells(vLin, 1) = .ListItems(I)
Sheets("Impressao").Cells(vLin, 2) = .ListItems(I).ListSubItems(1)
Sheets("Impressao").Cells(vLin, 3) = .ListItems(I).ListSubItems(2)
Sheets("Impressao").Cells(vLin, 4) = .ListItems(I).ListSubItems(3)
Next I
End With
MsgBox "dados imprimidos com sucesso folha impressao", vbInformation, "Escola Saberexcel VBA Estudos®"
'sbx_impressao
'sbx_limpar_Impressao
End Sub

Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.

Baixe o exemplo de planilha contendo os objetos e procedimentos aicma.
icon Excel vba planilha ListView busca dados soma valores (52.97 KB)

Tags: