Agrupar dados por data

Visual Basic for Aplication e macros no Excel.
Regras do fórum
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde. Imagem

Agrupar dados por data

Mensagempor fbrisso » Ter Nov 26, 2019 10:28 am

Pessoal, boa noite!

No tópico Agrupar dados do BD por data, nosso amigo FarahA resolveu meu problema em que, quando eu determinava um intervalo de datas, eu queria que a rotina buscasse os lançamentos num BD e os agrupasse nas colunas de acordo com seu respectivo dia.

Porém, agora identifiquei um outro ponto que não tinha me atentado e, novamente, só consegui resolver através de fórmulas.

Por exemplo, estou filtrando os dados no intervalo de 01/10 a 30/10.
Nesse caso, a rotina atual busca no banco de dados todos as datas que possuem algum lançamento nesse período e lista-as para mim, tudo certinho. Entretanto, se eu tive um lançamento no dia 01/10 e depois outro somente no dia 05/10, ela não aparece os dias 02, 03 e 04.

Sendo assim, gostaria que, se possível, o código fizesse uma listagem com todos os dias do período e depois buscasse lá no BD esses respectivos lançamentos.

Tentei alterar a solução proposta por ele, mas sem sucesso.
Resolvi parcialmente criando uma nova tabela com ÍNDICE e CORRESP, porém, é uma rotina a mais e desnecessária que, ao meu ver, poderia ser inclusa nesse código.


A planilha pode ser baixada nesse link: https://www.sendspace.com/file/b71pmf
Obrigado!!
fbrisso
Membro
Membro
 
Mensagens: 23
Registrado em: Seg Jul 14, 2014 5:37 pm
Has thanked: 5 times
Have thanks: 1 time

{ SO_SELECT }

Re: Agrupar dados por data

Mensagempor Coutinho » Ter Nov 26, 2019 2:13 pm

fbrisso, não compreendi o que precisa.

Vi o exemplo e a filtragem funciona corretamente entre o período que mencionou.
Detalhe melhor o que pretende, pois essa questão :
Por exemplo, estou filtrando os dados no intervalo de 01/10 a 30/10.
Nesse caso, a rotina atual busca no banco de dados todos as datas que possuem algum lançamento nesse período e lista-as para mim, tudo certinho. Entretanto, se eu tive um lançamento no dia 01/10 e depois outro somente no dia 05/10, ela não aparece os dias 02, 03 e 04.


Ficou confuso, pois se só tem os lançamentos do dia 01/10 e depois somente do dia 05/10 em diante, como obter o resultado com dados que não existem ?

[]s
Mauro Coutinho
Mauro Coutinho
com novo usuário devido a manutenção do grupo
Coutinho
Ninja do Excel
Ninja do Excel
 
Mensagens: 136
Registrado em: Qua Jun 12, 2019 6:18 pm
Has thanked: 6 times
Have thanks: 65 times

Re: Agrupar dados por data

Mensagempor fbrisso » Qua Nov 27, 2019 2:26 pm

Coutinho, o exemplo em anexo está funcionando perfeitamente sim, mas o que eu precisaria na verdade é o seguinte:

Quando eu colocar o período de datas e filtrar, o código criaria linha a linha pra mim esse período na nova coluna DATA. Por exemplo, 01/10, 02/10, 03/10 ... 31/10.
Depois de criar essa listagem, ele faria o filtro como está fazendo já hoje e distribuiria nos respectivos dias. Quando houver um dia que não tenha nenhum registro, ele ficaria em branco mesmo, mas na coluna data, o dia estará lá.

Só para exemplificar melhor, esse relatório será um modelo de Espelho ponto. Então, o colaborador passará o crachá para registrar o ponto. Ao fim do mês, gero essa listagem e ele confere os registros dia a dia.
Editado pela última vez por rlm em Qua Nov 27, 2019 2:27 pm, em um total de 1 vez.
Razão: Não utilizar o tag quote sem necessidade
fbrisso
Membro
Membro
 
Mensagens: 23
Registrado em: Seg Jul 14, 2014 5:37 pm
Has thanked: 5 times
Have thanks: 1 time

Re: Agrupar dados por data

Mensagempor fbrisso » Qua Dez 04, 2019 7:38 pm

Apenas ilustrando, segue o link de como eu precisaria dos dados na planilha. :D

https://www.sendspace.com/file/77aqcg
fbrisso
Membro
Membro
 
Mensagens: 23
Registrado em: Seg Jul 14, 2014 5:37 pm
Has thanked: 5 times
Have thanks: 1 time

Re: Agrupar dados por data

Mensagempor fbrisso » Qua Dez 11, 2019 10:38 pm

Ninguém? :P
fbrisso
Membro
Membro
 
Mensagens: 23
Registrado em: Seg Jul 14, 2014 5:37 pm
Has thanked: 5 times
Have thanks: 1 time

Re: Agrupar dados por data

Mensagempor klarc28 » Seg Dez 23, 2019 11:00 am

Código: Selecionar todos
Sub exemplo()

Dim Dados As Worksheet
Dim ulA As Double, ulB As Double, X As Double, Z As Double, Y As Double, W As Double

Set Dados = Sheets("Dados")

ulA = Dados.Cells(Rows.Count, 1).End(xlUp).Row
ulB = Dados.Cells(Rows.Count, 7).End(xlUp).Row

If ulB > 1 Then
    Range("G2:P" & ulB) = Empty
End If

For X = 5 To ulA
ulB = Dados.Cells(Rows.Count, 7).End(xlUp).Row
    If Dados.Cells(X, 2).Value = Dados.Cells(2, 2).Value Or Dados.Cells(2, 2) = Empty Then
        If Dados.Cells(X, 1).Value <= Dados.Cells(2, 4).Value Then
            If Dados.Cells(X, 1).Value >= Dados.Cells(2, 3).Value Then
                For Y = 2 To ulB
                    If Dados.Cells(X, 1).Value & Dados.Cells(X, 2).Value = Dados.Cells(Y, 7).Value & Dados.Cells(Y, 8) Then
                        If Dados.Cells(X, 3).Value = "ENTRADA" Then
                            For Z = 9 To 15 Step 2
                                If Dados.Cells(Y, Z) = Dados.Cells(X, 4) Then
                                GoTo trab
                                End If
                                If Dados.Cells(Y, Z) = Empty Then
                                    Dados.Cells(Y, Z) = Dados.Cells(X, 4)
                                    GoTo trab
                                End If
                            Next Z
                        End If
                        If Dados.Cells(X, 3).Value = "SAÍDA" Then
                            For W = 10 To 16 Step 2
                                If Dados.Cells(Y, W) = Dados.Cells(X, 4) Then
                                GoTo trab
                                End If
                                If Dados.Cells(Y, W) = Empty Then
                                    Dados.Cells(Y, W) = Dados.Cells(X, 4)
                                    GoTo trab
                                End If
                            Next W
                        End If
                    End If
                Next Y
                Dados.Cells(ulB + 1, 7) = Dados.Cells(X, 1).Value
                Dados.Cells(ulB + 1, 8) = Dados.Cells(X, 2).Value
                If Dados.Cells(X, 3).Value = "ENTRADA" Then
                Dados.Cells(ulB + 1, 9) = Dados.Cells(X, 4).Value
                End If
                If Dados.Cells(X, 3).Value = "SAÍDA" Then
                Dados.Cells(ulB + 1, 10) = Dados.Cells(X, 4).Value
                End If
            End If
        End If
    End If
trab:
Next X



Dim linha As Long
Dim linha2 As Long
linha = 2
Dim dt As Date
dt = Dados.Range("C2").Value
Dim encontrou As Boolean
Dim encontrou2 As Boolean
inicio:
linha = 2
While dt <= CDate(Dados.Range("D2").Value)


encontrou = False

While Dados.Range("G" & linha).Value <> "" And encontrou = False

If CDate(Dados.Range("G" & linha).Value) = dt Then

encontrou = True

End If

If encontrou = False Then


linha2 = 2
encontrou2 = False

While Dados.Range("G" & linha2).Value <> ""

linha2 = linha2 + 1

Wend
Dados.Range("G" & linha2).Value = dt


    Range("G2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveWorkbook.Worksheets("Dados").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Dados").Sort.SortFields.Add Key:=Range("G2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dados").Sort
        .SetRange Range("G2:L" & linha2)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    dt = dt + 1
   
GoTo inicio
End If


linha = linha + 1

Wend

dt = dt + 1
Wend
Range("B2").Select
ThisWorkbook.Save

End Sub

Sub organizar()
Dim Dados As Worksheet
Dim ulA As Double

Set Dados = Sheets("Dados")

ulA = Dados.Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

    Dados.Select
    Range("A4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Dados.Sort.SortFields.Clear
    Dados.Sort.SortFields.Add2 Key:=Range("A5:A" & ulA), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Dados.Sort.SortFields.Add2 Key:=Range("D5:D" & ulA), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Dados.Sort
        .SetRange Range("A4:D" & ulA)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
Application.ScreenUpdating = True
Range("A4").Select
End Sub
Sub Macro1(Control As IRibbonControl)
Call exemplo
End Sub

Sub Macro2(Control As IRibbonControl)
Call organizar
End Sub




https://drive.google.com/file/d/1N6LB0wFOb8t2JnnOsyIuV_WMLPgglZ0t/view?usp=sharing
É estudando que se consegue. Quando quiser agradecer, clique no joinha. Marque como resolvido na parte que resolveu sua dúvida.
klarc28
Membro
Membro
 
Mensagens: 1409
Registrado em: Sáb Dez 09, 2017 12:33 am
Has thanked: 35 times
Have thanks: 592 times


Voltar para VBA & Macros

Quem está online

Usuários navegando neste fórum: Nenhum usuário registrado e 5 visitantes