Somar linhas e trazer total, e depois excluir linhas somadas

2024 - VBA & Macros

Post Recente por pulujr 10 anos atrás

5 Posts

2 Usuários

0 Reactions

764 Visualizações

RSS

pulujr

(@pulujr)

Posts: 3

New Member

Topic starter

Boa noite,

Pessoal,coloquei uma planilha em anexo nesse novo topico e queria o auxilio de vocês para criar uma macro onde fosse criado duas linhas acima da linha com os totais( na planilha em anexo ja esta criado uma linha azul e outra amarelo), onde na linha amarela eu iria somar os valores das colunas C e D das celulas que as 3 primeiras letras da coluna B sejam NEG ou OL ,e logo apos somar essas linhas e trazer o valor para a linha amarela que sera criada acima do total ( Ultima linha da planilha), assim que trouxer o valor das linhas amarelas eles devem ser excluidas, e apos a exclusão das linhas amarelas, trazer na linha azul a soma das colunas C e D que restaram acima da linha azul, a planilha nao precisa ter as cores amarelo e azul, coloquei as cores so para tentar explicar melhor. Quando trouxer os valores para a linha amarela, devera apresentar na coluna b o texto " TOTAL OL + NEGOCIADOS", e na coluna a o mesmo texto " REDE X", e na coluna B da Linha Azul trazer o texto " Total" e na coluna A o texto "REDE X".

Postado : 16/06/2015 8:11 pm

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Bom dia!!

Tente algo assim..

Option Explicit

Sub AleVBA_16244()
    Dim lastrow As Long
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
        With Worksheets("Plan1").Range("$A$1")
            .AutoFilter field:=1, Criteria1:=Array("Total OL + Negociados", "Totais", "Total"), Operator:=xlFilterValues
            .Resize(Rows.Count - 1).Offset(1).EntireRow.Delete
        End With
        ActiveSheet.AutoFilterMode = False
    
        [E1].Value = "AleVBA"
        [F1].Value = "Total OL + Negociados"
        [J1].Value = "Total"
        [N1].Value = "Totais"
        Range("E2").Formula = "=IF(OR(LEFT(B2,3)=""NEG"",LEFT(B2,2)=""OL""),1,0)"
        Range("E2").AutoFill Destination:=Range("E2:E" & lastrow)
        Range("E2:E" & lastrow).Value = Range("E2:E" & lastrow).Value
            With Worksheets("Plan1")
            'Total OL + Negociados
                .Range("A1:E" & lastrow).AutoFilter field:=5, Criteria1:=1
                [I1].Formula = "=SUBTOTAL(9,R2C4:R1000C4)"
                [I1].Value = [I1].Value
                .AutoFilterMode = False
            'Total
                .AutoFilterMode = False
                .Range("A1:E" & lastrow).AutoFilter field:=5, Criteria1:=0
                [M1].Formula = "=SUBTOTAL(9,R2C4:R1000C4)"
                [M1].Value = [M1].Value
                .AutoFilterMode = False
            'Totais
                [Q1].Formula = "=SUM(D:D)"
                [Q1].Value = [Q1].Value
                'Prepara os totais e subtotais
                .Range("F1:I1").Copy Destination:=.Range("A60000").End(xlUp).Offset(1, 0)
                .Range("J1:M1").Copy Destination:=.Range("A60000").End(xlUp).Offset(1, 0)
                .Range("N1:Q1").Copy Destination:=.Range("A60000").End(xlUp).Offset(1, 0)
                .Columns("E:Q").EntireColumn.Delete
            End With
    Application.ScreenUpdating = True
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 19/06/2015 8:27 am