Notifications

Clear all

SubTotal após filtro com critério

2024 - VBA & Macros

Post Recente por Fernando Fernandes 7 anos atrás

9 Posts

3 Usuários

0 Reactions

1,566 Visualizações

RSS

elosprod

(@elosprod)

Posts: 18

Active Member

Topic starter

Boa noite, sou apaixonado por VBA e planilhando é minha bíblia.

Não consigo colocar o valor de SUBTOTAL na planilha anexo aba Carregamento, já tentei vários códigos mas sempre retorna o valor errado.
Será que poderiam me ajudar?

cheguei até aqui:

Sub Relatorio_carregamento()

Sheets("Planilha Milenium").Select

relatorio_fdgiga

    Application.ScreenUpdating = False
    Sheets("Carregamento").Visible = True
    Sheets("Carregamento").Select
    Range("A1").Select
    ActiveCell = "RELATÓRIO LONDRINA - FD GIGA"
    Range("A2").Select
    ActiveCell = "VALOR"
    Range("A1048576").End(xlUp).Offset(1, 0).Select
    ActiveCell = "subtotal da coluna D do relatorio gerado pelo critério da planilha milenium"

           '*Aqui gostaria de inserir o subtotal da coluna "D" do relatorio gerado pelo critério da planilha milenium* total de valores
          
Range("A1048576").End(xlUp).Offset(1, 0).Select

ActiveCell = "VOLUMES"
   Range("A1048576").End(xlUp).Offset(1, 0).Select
    '*Aqui gostaria de inserir o subtotal da coluna "I" do relatorio gerado pelo critério da planilha milenium* total de volumes
    ActiveCell = "subtotal da coluna I do relatorio gerado pelo critério da planilha milenium"
    
Código do relatório com critério

Sub relatorio_apucarana()

'
    Sheets("Planilha Milenium").Select
    retirar_filtro
    ActiveSheet.Range("$A$2:$O$3878").AutoFilter Field:=3, Criteria1:="="
    ActiveSheet.Range("$A$2:$O$3878").AutoFilter Field:=7, Criteria1:= _
        "APUCARANA"
    ActiveWindow.SmallScroll Down:=-123

End Sub

Anexei planilha, o código que preciso alterar está no módulo 9.

Postado : 17/01/2018 4:02 pm

Osvaldomp

(@osvaldomp)

Posts: 858

Prominent Member

...sou apaixonado por VBA ...

Dicas:
1. escreva os seus códigos sem utilizar o comando Select
2. esta expressão ~~~> Range("A1048576").End(xlUp).Offset(1, 0)... ~~~> só funciona a partir do Excel 2007, nas versões anteriores provocará erro; esta funciona em qualquer versão ~~~> Cells(Rows.Count, "A").End(xlUp).Offset(1)...

para contar valores:

Cells(Rows.Count, 1).End(xlUp).Offset(1).FormulaLocal = _
"=SUBTOTAL(103;D2:D" & Cells(Rows.Count, 4).End(xlUp).Row & ")"

para somar valores

Cells(Rows.Count, 1).End(xlUp).Offset(1).FormulaLocal = _
"=SUBTOTAL(109;D2:D" & Cells(Rows.Count, 4).End(xlUp).Row & ")"

Osvaldo

Postado : 17/01/2018 5:56 pm

elosprod

(@elosprod)

Posts: 18

Active Member

Topic starter

Obrigado Osvaldo, vou testar aqui e já agradeço pela dica!

Grande abraço

Postado : 18/01/2018 1:43 pm

elosprod

(@elosprod)

Posts: 18

Active Member

Topic starter

Não funcionou!, não entendi onde colocar o código

Postado : 18/01/2018 2:01 pm

Osvaldomp

(@osvaldomp)

Posts: 858

Prominent Member

Coloque exatamente na parte que você pediu:

Range("A1048576").End(xlUp).Offset(1, 0).Select
ActiveCell = "subtotal da coluna D do relatorio gerado pelo critério da planilha milenium"

'*Aqui gostaria de inserir o subtotal da coluna "D" do relatorio gerado pelo critério da planilha milenium* total de valores

Osvaldo

Postado : 18/01/2018 2:07 pm

elosprod

(@elosprod)

Posts: 18

Active Member

Topic starter

Entendi, retorna falso pois o código é rodado na sheet carregamento e a referencia de subtotal teria de ser da sheet planilha milenium.

Agradeço até aqui, pois funciona em outro relatório que tenho aqui.

mas vou tentar ainda acertar. se estiver entendendo o que peço e poder ajudar fico novamente grato.

Postado : 18/01/2018 2:38 pm

Osvaldomp

(@osvaldomp)

Posts: 858

Prominent Member

Experimente:

substitua as duas linhas abaixo

 Range("A1048576").End(xlUp).Offset(1, 0).Select
   ActiveCell = "subtotal da coluna D do relatorio gerado pelo critério da planilha milenium"

por estas

Cells(Rows.Count, 1).End(xlUp).Offset(1).FormulaLocal = _
     "=SUBTOTAL(109;'Planilha Milenium'!D2:D" & Sheets("Planilha Milenium").Cells(Rows.Count, 4).End(xlUp).Row & ")"

Osvaldo

Postado : 19/01/2018 2:24 pm