Excel Loop pra transferir valor de sábado para o dia anterior ou posterior

[Scofieldgyn]

Deparei com um necessidade e pela complexidade não consegui nem começar a escrever o código Quem puder me ajudar, segue arquivo em anexo com as orientações que preciso.

 

Preciso que avalie o impacto do loop se não vai onerar muito tempo de processamento, pois a quantidade de linhas é gigantesca, podendo ultrapassar mais de 600.000 linhas.

 

Desde já agradeço.

Loop pra transferir Volume de Sábado para Sexta.xlsx

[Midori]

@Scofieldgyn Sua planilha pode ter uma coluna auxiliar com uma fórmula para identificar os sábados e domingos, p.ex,

 

 

A tabela está ordenada por data e para cada caso de sábado e domingo marquei com SD-1 o que começa no primeiro dia do mês e SD-2 os outros. Assim a macro só terá que procurar com Find os casos de SD e depois o próximo (PRX). E quando for SD-1 a busca será para as linhas abaixo e SD-2 acima (datas anteriores no mesmo mês). Essa seria a lógica para encontrar a linha da soma.

[Scofieldgyn]

@Midori Certo, com a coluna auxiliar é de boa, mas achei que seria possível montar isso apenas no loop sem criar colunas auxiliares, mas entendo que não é tão simples assim para o algorítimo.

 

Enfim, mesmo com a coluna auxiliar você pode me ajudar com o loop, tenho muita dificuldades com iterações.

[Midori]

@Scofieldgyn É possível montar sem coluna auxiliar, mas acho que fica mais lento. Testei na sua planilha de exemplo e talvez seja preciso fazer ajustes para algum caso não previsto no código,

 

Sub ProcuraSD()
    Dim ProcSD      As Range
    Dim ProcPRX     As Range
    Dim TotalQtd    As Long
    Dim TotalVol    As Single
    Dim Direcao     As XlSearchDirection
    
    Do
        Set ProcSD = [U:U].Find(What:="SD", LookIn:=xlValues, LookAt:=xlPart)
        
        If Not ProcSD Is Nothing Then
            TotalQtd = WorksheetFunction.SumIf([I:I], ProcSD(, -11), [J:J])
            TotalVol = WorksheetFunction.SumIf([I:I], ProcSD(, -11), [K:K])
            Direcao = IIf(Split(ProcSD.Value, "-")(1) = 1, xlNext, xlPrevious)
            Set ProcPRX = [U:U].Find( _
                What:="PRX", _
                After:=ProcSD, _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchDirection:=Direcao)
            
            If Not ProcPRX Is Nothing Then
                ProcPRX(, -10).Value = ProcPRX(, -10).Value + TotalQtd
                ProcPRX(, -9).Value = ProcPRX(, -9).Value + TotalVol
                
                If Direcao = xlNext Then
                   ProcSD.Resize(ProcPRX.Row - ProcSD.Row).EntireRow.Delete
                Else
                   ProcSD.EntireRow.Delete
                End If
            End If
        End If
    Loop Until ProcSD Is Nothing
End Sub

 

[Scofieldgyn]

@Midori

 

Fiz os teste, segue os pontos que identifiquei de oportunidade de ajustes:

 

1º - Ao rodar a macro, ela está copiado os dados do dia 01/10 sábado e colocando no dia 07/10.

2º - O código precisa rodar sku por sku, no caso desse, está sombando todos.

3º No final da Rotina está aparecendo um erro: 

Erro destacado na linha destacada em azul.

Loop pra transferir Volume de Sábado para Sexta.zip

[Midori]

@Scofieldgyn A tabela não está em ordem de data, tem que deixar em ordem crescente antes. Veja se assim consegue rodar para depois acrescentar a soma por sku.

[Scofieldgyn]

@Midori Verdade, você havia dito isso antes e eu esqueci.

 

Bom, funcionou, porém a macro está agrupando a soma de todos os códigos skus, é possível que seja feita por sku?

 

outro ponto é que o loop ainda continua dando o erro no final da execução conforme informado anteriormente.

[Midori]

@Scofieldgyn Como você não especificou a soma por Sku, deixei a macro somando todos. Mas vamos supor este caso hipotético do 1100 caindo no dia 01/10, como deve ficar?

 

 

Sobre o erro na macro, está acontecendo porque você colocou o nome da coluna como ProcSD, então o Find está pegando essa célula e aí acontece o erro no Split já que o texto não está no padrão da fórmula com o delimitador. Para resolver você pode evitar colocar na coluna U qualquer texto com SD ou então colocar uma condicional no código para Split receber só o texto da fórmula na tabela.

[Scofieldgyn]

@Midori

 

Modifiquei a base pra dar uma alusão mais assertiva de entendimento. Repare que para o sku 1100, a soma total do dia 01/10 é de 43,5 e quando for colocado na data do dia 03/11, o total deverá ficar em 44.

 

[Midori]

@Scofieldgyn Minha questão é diferente, no meu exemplo o dia 01/10 cai em dois códigos e é a última data do 1100.

[Scofieldgyn]

@Midori 

 

Por isso coloquei outro exemplo, pois o anterior não estava coerente. Nesse ficou melhor porque ambos códigos tem dia 01/10 e 03/11. 

 

No exemplo em anexo explica melhor a soma.

Loop pra transferir Volume de Sábado para Sexta.zip

[Midori]

@Scofieldgyn Como não respondeu especificamente o que perguntei, vou considerar que casos assim não vão acontecer. Fiz alguns ajustes no código e acrescentei um procedimento para deixar a tabela em ordem,

 

Const FORMULA   As String = _
    "=IF(WEEKDAY(RC[-12])>=7," & _
    "IF(MONTH(RC[-12])<>MONTH(R[-1]C[-12]),""SD-1"",""SD-2""),""PRX"")"

Sub Atualiza()
    Call ProcuraSD(ActiveSheet)
End Sub

Sub OrdenaTabela(Planilha As Worksheet)
    Dim Area        As Range
    
    Set Area = Planilha.[A1].CurrentRegion
    
    With Planilha.Sort
        Call .SortFields.Clear
        Call .SortFields.Add2( _
            Key:=Area.Columns(Planilha.[A:A].Column), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal)
        Call .SortFields.Add2( _
            Key:=Area.Columns(Planilha.[I:I].Column), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal)
        Call .SetRange(Area)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        Call .Apply
    End With
End Sub

Function ProcuraSD(Planilha As Worksheet) As Integer
    Dim ProcSD      As Range
    Dim ProcPRX     As Range
    Dim TotalQtd    As Long
    Dim Linhas      As Long
    Dim TotalVol    As Single
    Dim VarSD       As Variant
    Dim Direcao     As XlSearchDirection
    
    Call OrdenaTabela(Planilha)
    
    Do
        Set ProcSD = Planilha.[U:U].Find(What:="SD-", LookIn:=xlValues, LookAt:=xlPart)
        
        If Not ProcSD Is Nothing Then
            TotalQtd = WorksheetFunction.SumIf(Planilha.[I:I], ProcSD(, -11), Planilha.[J:J])
            TotalVol = WorksheetFunction.SumIf(Planilha.[I:I], ProcSD(, -11), Planilha.[K:K])
            VarSD = Split(ProcSD.Value, "-")
            
            If UBound(VarSD) = 1 Then
                Direcao = IIf(VarSD(1) = 1, xlNext, xlPrevious)
                Set ProcPRX = Planilha.[U:U].Find( _
                    What:="PRX", _
                    After:=ProcSD, _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchDirection:=Direcao)
            
                If Not ProcPRX Is Nothing Then
                    ProcPRX(, -10).Value = ProcPRX(, -10).Value + TotalQtd
                    ProcPRX(, -9).Value = ProcPRX(, -9).Value + TotalVol
                
                    If Direcao = xlNext Then
                        If ProcPRX.Row <= ProcSD.Row Then
                            '#######
                            ProcuraSD = -1
                            Exit Do
                            '#######
                        End If
                        ProcSD.Resize(ProcPRX.Row - ProcSD.Row).EntireRow.Delete
                    Else
                        ProcSD.EntireRow.Delete
                    End If
                    Linhas = WorksheetFunction.CountA(Planilha.[A:A]) - 1
                    Planilha.[U2].Resize(Linhas).FormulaR1C1 = FORMULA
                Else
                '#######
                ProcuraSD = -1
                Exit Do
                '#######
                End If
            Else
                '#######
                ProcuraSD = -1
                Exit Do
                '#######
            End If
        End If
    Loop Until ProcSD Is Nothing
End Function

 

[Scofieldgyn]

@Midori Exatamente isso, está funcionando perfeitamente.

 

Obrigado.

 

Ah, deu erro na linha de ordenação devido está com numeração 2 na frente do Add, retirei o número e o código rodou liso.

 

        Call .SortFields.Clear
        Call .SortFields.Add2( _
            Key:=Area.Columns(Planilha.[A:A].Column), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal)
        Call .SortFields.Add2( _
            Key:=Area.Columns(Planilha.[I:I].Column), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal)

 

[Midori]

@Scofieldgyn Acabou faltando a soma por Sku, no outro estava somando todos, faça alguns testes,

 

Function ProcuraSD(Planilha As Worksheet) As Integer
    Dim ProcSD      As Range
    Dim ProcPRX     As Range
    Dim TotalQtd    As Long
    Dim TotalVol    As Single
    Dim VarSD       As Variant
    Dim Direcao     As XlSearchDirection
    
    Call OrdenaTabela(Planilha)
    
    Do
        Set ProcSD = Planilha.[U:U].Find(What:="SD-", LookIn:=xlValues, LookAt:=xlPart)
        
        If Not ProcSD Is Nothing Then
            VarSD = Split(ProcSD.Value, "-")
            
            If UBound(VarSD) = 1 Then
                TotalQtd = WorksheetFunction.SumIfs( _
                    Planilha.[J:J], Planilha.[I:I], ProcSD(, -11), Planilha.[A:A], ProcSD.Value)
                TotalQtd = WorksheetFunction.SumIfs( _
                    Planilha.[K:K], Planilha.[I:I], ProcSD(, -11), Planilha.[A:A], ProcSD.Value)
                Direcao = IIf(VarSD(1) = 1, xlNext, xlPrevious)
                
                Set ProcPRX = Planilha.[U:U].Find( _
                    What:="PRX", _
                    After:=ProcSD, _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchDirection:=Direcao)
            
                If Not ProcPRX Is Nothing Then
                    If ProcPRX(, -18).Value = ProcSD(, -18).Value Then
                        ProcPRX(, -10).Value = ProcPRX(, -10).Value + TotalQtd
                        ProcPRX(, -9).Value = ProcPRX(, -9).Value + TotalVol
                
                        If Direcao = xlNext Then
                            If ProcPRX.Row <= ProcSD.Row Then
                                '#######
                                ProcuraSD = -1
                                Exit Do
                                '#######
                            End If
                            ProcSD.Resize(ProcPRX.Row - ProcSD.Row).EntireRow.Delete
                            ProcPRX.FormulaR1C1 = FORMULA
                        Else
                            ProcSD.EntireRow.Delete
                            ProcPRX(2).FormulaR1C1 = FORMULA
                        End If
                    Else
                        ProcSD.Value = "NDA"
                    End If
                Else
                    '#######
                    ProcuraSD = -1
                    Exit Do
                    '#######
                End If
            Else
                '#######
                ProcuraSD = -1
                Exit Do
                '#######
            End If
        End If
    Loop Until ProcSD Is Nothing
End Function

 

 

[Scofieldgyn]

@Midori

 

No código anterior aparentemente estava funcionando normalmente, com esse último que me passou, está deletando as linhas de sábado sem fazer a soma.

 

Fique um tempo aqui tentando entender onde poderia ajustar, mas meu cérebro embaralhou e não consegui resolver rsrsrs

 

 

Loop pra transferir Volume de Sábado para Sexta.zip

[Midori]

48 minutos atrás, Scofieldgyn disse:

está deletando as linhas de sábado sem fazer a soma.

Nos SumIfs atribuí duas vezes TotalQtd e passei incorretamente o argumento para a o último critério, esta é a correção,

 

TotalQtd = WorksheetFunction.SumIfs( _
    Planilha.[J:J], Planilha.[I:I], ProcSD(, -11), Planilha.[A:A], ProcSD(, -19).Value)
                
TotalVol = WorksheetFunction.SumIfs( _
    Planilha.[K:K], Planilha.[I:I], ProcSD(, -11), Planilha.[A:A], ProcSD(, -19).Value)

 

[Scofieldgyn]

@Midori

Está rodando normal quando o critério não é o último dia do mês.

 

Quando se tratar do último dia do mês caindo no sábado, note que ele está executando corretamente apenas para o primeiro sku, chega no segundo não faz nada.

 

Base antes de rodar o código.

 

 

Base após executar.

Note que ainda permanece o 01/10 sábado no sku 2200, ou seja, não somou com o dia 03/10.

[Midori]

@Scofieldgyn Casos assim é o que eu tinha perguntando antes. Como deve ficar?

[Scofieldgyn]

@Midori

soma deverá ocorrer para cada sku como aconteceu com o 1100 que deu super certo.

 

O problema é só pra nos casos onde o cai o sábado sendo o dia 1 de cada mês, diferente disso está rodando corretamente.

[Midori]

@Scofieldgyn Sim, a soma deve acontecer para cada Sku.

 

O que ainda não está claro é o que deve ser feito quando a última data (ou única) de algum Sku tem dados no primeiro dia do mês que caia no sábado ou domingo. Quando isso acontece os dados dessa data permanecem na tabela ou devem ser somada no próximo Sku mesmo que seja diferente?

[Scofieldgyn]

@Midori

O que ainda não está claro é o que deve ser feito quando a última data (ou única) de algum Sku tem dados no primeiro dia do mês que caia no sábado ou domingo

Deverá cair no próximo dia útil do mesmo mês. Sábado e domingos impreterivelmente não pode ter volume, inclusive excluídos da planilha.

 

Quando isso acontece os dados dessa data permanecem na tabela ou devem ser somada no próximo Sku mesmo que seja diferente?

Resp: Não deverá somar em sku diferente.

 

[Midori]

12 minutos atrás, Scofieldgyn disse:

Deverá cair no próximo dia útil do mesmo mês.

Então neste exemplo do Sku 1100 a data deve ser alterada para 03/10?

 

Já que esse é o último lançamento nesse código.

 

[Scofieldgyn]

@Midori

 

Então neste exemplo do Sku 1100 a data deve ser alterada para 03/10?

Exatamente isso. Mas se notar, com o código que me passou, ele já está fazendo isso, o problema que eu relatei é que quando vai para o próximo sku, não faz nada.

 

 

Já que esse é o último lançamento nesse código.

não entendi quando diz último lançamento, se notar ainda tem o dia 07/10 e demais dias no decorrer do mês.

 

[Midori]

1 minuto atrás, Scofieldgyn disse:

não entendi quando diz último lançamento, se notar ainda tem o dia 07/10 e demais dias no decorrer do mês.

No Sku 1100 é o último lançamento.

 

O do dia 07/10 está para o 1111.

[Scofieldgyn]

@Midori Verdade, é olhei rapidamente para os códigos e achei que era um só.