Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
incluir 1 linha com...
 
Notifications
Clear all

incluir 1 linha com contagem total dos critérios

 
2024 - VBA & Macros
Post Recente por Creuza 7 anos atrás
4 Posts
2 Usuários
0 Reactions
1,167 Visualizações
RSS
 Creuza
(@creuza)
Posts: 15
Active Member
Topic starter
 

Prezados colegas, Boa noite!

Ainda em minha jornada para fazer o relatório conforme solicitado no tópico viewtopic.php?f=10&t=26433 estou quase conseguindo !

Já consigo extrair os dados conforme critério, mas (sempre tem um mas...) vamos lá!

1- As informações estão sendo coladas na coluna Q (ou 16) e quando modifico a linha de código para colar na coluna A, o código retorna apenas uma coluna e mais nada. Se coloco i ao invés de 1 ou "a" ele preenche tudo só que na coluna Q. Na fonte de dados , o que eu quero que retorne o que está apartir da coluna Q até a coluna AZ.

Como colocar para os dados serem colados a partir da coluna1, linha5?

     For x = 2 To Ultimalinha
                If Planilha4.Cells(x, 14) = "Trindade" And Planilha4.Cells(x, 15) = "Fiscal" Then
                    For i = 17 To ultimacoluna
                    Planilha3.Cells(linha,[b] i)[/b] = Planilha4.Cells(x, i)
                    Next
                linha = linha + 1
                
                End If
             Next

2- Quero entre um critério e outro, (são 19 no total), incluir uma linha de total de dados do critério (uma linha com um cont.se ou cont valores) adicionar uma linha em branco e copiar os cabeçários de critérios para então adicionar outro grupo mais ou menos assim: 

Sub Escala_Trindade()
Dim z As Long
Application.ScreenUpdating = False
        Sheets("Rel1").Range("a6:at3000").ClearContents

        Ultimalinha = Planilha4.Cells(Rows.Count, 52).End(xlUp).Row
        ultimacoluna = Planilha4.Cells(17, Columns.Count).End(xlToLeft).Column
        linha = 5
            For x = 2 To Ultimalinha
                If Planilha4.Cells(x, 14) = "Trindade" And Planilha4.Cells(x, 15) = "Caixa" Then
                    For i = 17 To ultimacoluna
                    Planilha3.Cells(linha, i) = Planilha4.Cells(x, i)
                    Next
                linha = linha + 1
                End If
     [b] 'inlcluir linha de total de entradas do critério
      'incluir linha em branco[/b]
             Next
      [b]"Incluir linha de cabeçalho[/b]
              For x = 2 To Ultimalinha
                If Planilha4.Cells(x, 14) = "Trindade" And Planilha4.Cells(x, 15) = "Fiscal" Then
                    For i = 17 To ultimacoluna
                    Planilha3.Cells(linha, i) = Planilha4.Cells(x, i)
                    Next
                linha = linha + 1
                
                End If
             Next

Como fazer?
Em anexo uma cópia da planilha e meus avanços. e uma arquivo chamado relatório que é uma imagem de como quero que pareça o relatório .
Estou com certa urgência para resolver isso , se alguém puder me ajudar serei eternamente grata.

 
Postado : 06/11/2017 5:42 pm
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Nao entendi direito, mas uma tabela dinamica nao resolve?

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 08/11/2017 5:29 pm
 Creuza
(@creuza)
Posts: 15
Active Member
Topic starter
 

Boa Tarde Prudêncio
Sim, porque traz a a informação mas não porque não traz da forma que preciso.
preciso do cabeçalho e da linha de contagem. para cada setor.

Já evolui e consegui com o seguinte código colocar o cabeçalho do setor, trazer as informações e fazer a linha de total do setor. como são 19 setores preciso descobrir como fazer o código funcionar para cada item.

Sub relatorio_Revisado()
    
    Sheets("Apoio").Range("z1:BI2").Copy
    Sheets("Rel1").Range("o3:ax4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Rel1").Range("o3:ax4").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Rel1").Cells(3, 15).Value = "Setor:Caixa"
    Sheets("Rel1").Range("A6:az50000").ClearContents
    ultimaLinha = Planilha4.Cells(Rows.Count, "a").End(xlUp).Row
    ultimaColuna = Planilha4.Cells(1, Columns.Count).End(xlToLeft).Column
    linha = 5
    
     For x = 5 To ultimaLinha
        If Planilha4.Cells(x, 12) = "Trindade" And Planilha4.Cells(x, 13) = "Caixa" Then
            For i = 15 To ultimaColuna
                Planilha3.Cells(linha, i) = Planilha4.Cells(x, i)
            Next
            linha = linha + 1
        End If
  Next
Range("o1048576").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = "Total Caixa"
ActiveCell.Offset(0, 2) = WorksheetFunction.CountIfs(Planilha4.Range("m7:m3000"), "Caixa", Planilha4.Range("l7:l3000"), "Trindade")
ActiveSheet.Cells(ActiveCell.Row + 2, ActiveCell.Column).Select
    
        
End Sub

E tenho este resultado

 
Postado : 09/11/2017 2:48 pm
 Creuza
(@creuza)
Posts: 15
Active Member
Topic starter
 

Demorou muito mais do que eu imaginava mas eu consegui.

Estou postando aqui o código que solucionou o meu problema, para caso no futuro alguém tiver um caso parecido poder, ao consultar o fórum, encontrar a luz no fim do túnel. 

Sub ImprimirRelatorioParaiso()
Dim linha As Long
Dim ultimaLinha As Long
Dim j As Long
Dim total As Long
Dim qtdeRegistros As Long
    Sheets(NomeRelatorio).Range("A1:az50000").ClearContents
    Sheets(NomeRelatorio).Range("A1:az50000").Delete
    Sheets(NomeRelatorio).Range("A1:az50000").Clear
    
    linha = 4
    listaSetores = pegarListaSetoresParaiso
    qtdeSetores = UBound(listaSetores)
    For i = 0 To qtdeSetores
        linha = linha + 1
        Sheets("Apoio").Range("z1:BI2").Copy
        Sheets(NomeRelatorio).Cells(linha, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Sheets(NomeRelatorio).Cells(linha, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Sheets(NomeRelatorio).Cells(linha, 1).Value = "Setor : " & UCase(listaSetores(i))
        linha = linha + 2
        For j = 6 To 50000
            If UCase(Sheets("Escala").Cells(j, 12).Value) = UCase("PARAISO") And UCase(Sheets("Escala").Cells(j, 13).Value) = UCase(listaSetores(i)) Then
                Sheets("Escala").Range("O" & j & ":AX" & j).Copy
                Sheets(NomeRelatorio).Cells(linha, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Sheets(NomeRelatorio).Cells(linha, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                linha = linha + 1
                ultimaLinha = linha
                total = total + 1
            End If
        Next
        
        Sheets(NomeRelatorio).Cells(linha, 1).Value = "Total " & total
        linha = linha + 1
        total = 0
    Next

           
End Sub

Desde já agradeço o interesse e ajuda de todos.

 
Postado : 20/11/2017 12:49 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico