Midori

@Linhoo Tem razão. O valor do custo total na ITEM 01 é 5,583405038 e não 5,58 como na proposta.

@Linhoo Na ITEM 01 está multiplicando o custo mensal por 22 e não por 12 como na proposta. E o custo diário na proposta não está só dividindo o mensal por 22, mas o cálculo da célula H134 com outros custos e imposto.

@João Pedro Soares Dentro de uma tabela acho que não é possível.

@Scofieldgyn Um detalhe que acabou passando. A fórmula não está pegando domingo e pode retornar #VALUE caso a primeira data da tabela seja sábado ou domingo. Esta é a correção, Const FORMULA As String = _ "=IF(OR(WEEKDAY(RC[-12])=7,WEEKDAY(RC[-12])=1)," & _ "IFERROR(IF(OR(MONTH(RC[-12])<>MONTH(" & _ "R[-1]C[-12]),RC[-20]<>R[-1]C[-20]),""SD-1"",""SD-2""),""SD-1""),""PRX"")"

@GENECIOFICIAL É só concatenar com a fórmula, =SE(DIA.DA.SEMANA(B1)<>2;"Não há visita Técnica";"Técnico - " & ÍNDICE({"PAULO";"LUÍS";"SILAS";"AUGUSTO";"ALMIR"};MOD(NÚMSEMANA(B1)-1;5)+1))

@GENECIOFICIAL Veja se assim resolve, =SE(DIA.DA.SEMANA(B1)<>2;"Não há visita Técnica";ÍNDICE({"PAULO";"LUÍS";"SILAS";"AUGUSTO";"ALMIR"};MOD(NÚMSEMANA(B1)-1;5)+1))

@Scofieldgyn Aqui não aconteceu nenhum erro. Tenta substituir a atribuição da fórmula nas duas linhas. Onde está assim, ProcPRX.Formula2R1C1 = FORMULA ... ProcPRX(2).Formula2R1C1 = FORMULA Deve ficar, Tabela(2, COL_PROC).Resize(Tabela.Rows.Count - 1).FormulaR1C1 = FORMULA

@Scofieldgyn A fórmula na planilha fica com erro, #N/D ou algo assim? Pode anexar a planilha de teste onde acontece esse erro?

@Scofieldgyn Editei essa linha para ficar compatível. Não precisa ordenar e editar a fórmula na planilha, a sub Atualiza já faz isso. Const FORMULA As String = _ "=IF(WEEKDAY(RC[-12])>=7,IF(OR(MONTH(RC[-12])<>" & _ "MONTH(R[-1]C[-12]),RC[-20]<>R[-1]C[-20]),""SD-1"",""SD-2""),""PRX"")" Const SD As String = "SD-" Const PRX As String = "PRX" Const COL_SKU As Integer = 1 Const COL_DAT As Integer = 9 Const COL_QTD As Integer = 10 Const COL_VOL As Integer = 11 Const COL_PROC As Integer = 21 Sub Atualiza() Dim Tabela As Range Set Tabela = [A1].CurrentRegion Call Tabela.Offset(1).Sort(Key1:=Tabela(2, COL_SKU), Key2:=Tabela(2, COL_DAT)) Tabela(2, COL_PROC).Resize(Tabela.Rows.Count - 1).FormulaR1C1 = FORMULA Call ProcuraSD(Tabela) End Sub Sub ProcuraSD(Tabela As Range) Dim ProcSD As Range Dim ProcPRX As Range Dim ProcSKU As Range Dim RngData As Range Dim RngVol As Range Dim RngQtd As Range Dim UltData As Date Dim ContaDataSku As Long Dim TotalQtd As Long Dim TotalVol As Single Dim VarSD As Variant Dim CodSku As String Dim Direcao As XlSearchDirection Do Set ProcSD = Tabela.Columns(COL_PROC).Find( _ What:=SD, LookIn:=xlValues, LookAt:=xlPart) If Not ProcSD Is Nothing Then VarSD = Split(ProcSD.Value, "-") CodSku = ProcSD(, -(COL_PROC - COL_SKU - 1)).Value Set RngData = ProcSD(, -(COL_PROC - COL_DAT - 1)) ContaDataSku = WorksheetFunction.CountIfs( _ Tabela.Columns(COL_DAT), RngData.Value, Tabela.Columns(COL_SKU), CodSku) UltData = Evaluate("MAX(IF(" & _ "'" & Tabela.Worksheet.Name & "'!" & _ Tabela.Columns(COL_SKU).Address & "=" & CodSku & "," & _ "'" & Tabela.Worksheet.Name & "'!" & _ Tabela.Columns(COL_DAT).Address & "))") TotalQtd = WorksheetFunction.SumIfs( _ Tabela.Columns(COL_QTD), _ Tabela.Columns(COL_DAT), RngData.Value, Tabela.Columns(COL_SKU), CodSku) TotalVol = WorksheetFunction.SumIfs( _ Tabela.Columns(COL_VOL), _ Tabela.Columns(COL_DAT), RngData.Value, Tabela.Columns(COL_SKU), CodSku) If UBound(VarSD) = 1 Then Direcao = IIf(VarSD(1) = 1, xlNext, xlPrevious) Set ProcPRX = Tabela.Columns(COL_PROC).Find( _ What:=PRX, _ After:=ProcSD, _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchDirection:=Direcao) If Not ProcPRX Is Nothing Then Set RngVol = ProcPRX(, -(COL_PROC - COL_VOL - 1)) Set RngQtd = ProcPRX(, -(COL_PROC - COL_QTD - 1)) If Direcao = xlNext Then If UltData = RngData.Value Then RngData.Resize(ContaDataSku).Value = _ WorksheetFunction.WorkDay(RngData.Value, 1) Else RngVol.Value = RngVol.Value + TotalVol RngQtd.Value = RngQtd.Value + TotalQtd ProcSD.Resize(ProcPRX.Row - ProcSD.Row).EntireRow.Delete ProcPRX.Formula2R1C1 = FORMULA End If Else RngVol.Value = RngVol.Value + TotalVol RngQtd.Value = RngQtd.Value + TotalQtd ProcSD.EntireRow.Delete ProcPRX(2).Formula2R1C1 = FORMULA End If End If End If End If Loop Until ProcSD Is Nothing End Sub

Qual foi a mensagem de erro? Talvez seja por causa da sua versão do Excel. No seu tem a fórmula MÁXIMOSES?

@Scofieldgyn Além da macro modifiquei a fórmula, =SE(DIA.DA.SEMANA(I2)>=7;SE(OU(MÊS(I2)<>MÊS(I1);A2<>A1);"SD-1";"SD-2");"PRX") Nos casos do último dia cair no sábado/domingo, usei a função Workday para pegar o próximo dia útil. Antes de rodar deixe a tabela em ordem. Const FORMULA As String = _ "=IF(WEEKDAY(RC[-12])>=7,IF(OR(MONTH(RC[-12])<>" & _ "MONTH(R[-1]C[-12]),RC[-20]<>R[-1]C[-20]),""SD-1"",""SD-2""),""PRX"")" Const SD As String = "SD-" Const PRX As String = "PRX" Const COL_SKU As Integer = 1 Const COL_DAT As Integer = 9 Const COL_QTD As Integer = 10 Const COL_VOL As Integer = 11 Const COL_PROC As Integer = 21 Sub Atualiza() Call ProcuraSD([A1].CurrentRegion) End Sub Sub ProcuraSD(Tabela As Range) Dim ProcSD As Range Dim ProcPRX As Range Dim ProcSKU As Range Dim RngData As Range Dim RngVol As Range Dim RngQtd As Range Dim UltData As Date Dim ContaDataSku As Long Dim TotalQtd As Long Dim TotalVol As Single Dim VarSD As Variant Dim CodSku As String Dim Direcao As XlSearchDirection Do Set ProcSD = Tabela.Columns(COL_PROC).Find( _ What:=SD, LookIn:=xlValues, LookAt:=xlPart) If Not ProcSD Is Nothing Then VarSD = Split(ProcSD.Value, "-") CodSku = ProcSD(, -(COL_PROC - COL_SKU - 1)).Value Set RngData = ProcSD(, -(COL_PROC - COL_DAT - 1)) ContaDataSku = WorksheetFunction.CountIfs( _ Tabela.Columns(COL_DAT), RngData.Value, Tabela.Columns(COL_SKU), CodSku) UltData = WorksheetFunction.MaxIfs( _ Tabela.Columns(COL_DAT), Tabela.Columns(COL_SKU), CodSku) TotalQtd = WorksheetFunction.SumIfs( _ Tabela.Columns(COL_QTD), _ Tabela.Columns(COL_DAT), RngData.Value, Tabela.Columns(COL_SKU), CodSku) TotalVol = WorksheetFunction.SumIfs( _ Tabela.Columns(COL_VOL), _ Tabela.Columns(COL_DAT), RngData.Value, Tabela.Columns(COL_SKU), CodSku) If UBound(VarSD) = 1 Then Direcao = IIf(VarSD(1) = 1, xlNext, xlPrevious) Set ProcPRX = Tabela.Columns(COL_PROC).Find( _ What:=PRX, _ After:=ProcSD, _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchDirection:=Direcao) Set RngVol = ProcPRX(, -(COL_PROC - COL_VOL - 1)) Set RngQtd = ProcPRX(, -(COL_PROC - COL_QTD - 1)) If Direcao = xlNext Then If UltData = RngData.Value Then RngData.Resize(ContaDataSku).Value = _ WorksheetFunction.WorkDay(RngData.Value, 1) Else RngVol.Value = RngVol.Value + TotalVol RngQtd.Value = RngQtd.Value + TotalQtd ProcSD.Resize(ProcPRX.Row - ProcSD.Row).EntireRow.Delete ProcPRX.Formula2R1C1 = FORMULA End If Else RngVol.Value = RngVol.Value + TotalVol RngQtd.Value = RngQtd.Value + TotalQtd ProcSD.EntireRow.Delete ProcPRX(2).Formula2R1C1 = FORMULA End If End If End If Loop Until ProcSD Is Nothing End Sub

No Sku 1100 é o último lançamento. O do dia 07/10 está para o 1111.

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 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 Casos assim é o que eu tinha perguntando antes. Como deve ficar?

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 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 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 Minha questão é diferente, no meu exemplo o dia 01/10 cai em dois códigos e é a última data do 1100.

@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 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 É 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 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.

@Luiz Filipe Porto Tem várias formas de fazer. A que acho mais simples é escolher um lugar na planilha para registrar a data da modificação, pode nas células das planilhas importadas ou então em outra aba para guardar só isso. Assim podemos aplicar algum algoritmo de ordenação para organizar as abas em ordem de modificação a partir da última data e hora. Para ordenar com base na célula X1 p.ex fica assim, Sub ImportaPlanilhas() Dim Arquivo As String Dim Diretorio As String Dim Pasta As Workbook Dim Planilha As Worksheet Diretorio = Environ("UserProfile") & "\Downloads\Teste\" Arquivo = Dir(Diretorio & "*.xlsx") Do Until Arquivo = "" Set Pasta = Workbooks.Open(Diretorio & Arquivo) Pasta.ActiveSheet.[A1].CurrentRegion.Copy Set Planilha = ThisWorkbook.Sheets.Add Planilha.Name = Replace(Pasta.Name, ".xlsx", "") Planilha.[X1] = FileDateTime(Diretorio & Arquivo) Planilha.[A1].PasteSpecial Application.CutCopyMode = False Pasta.Close Arquivo = Dir Loop Call OrdenaPlanilha(ThisWorkbook) End Sub Sub OrdenaPlanilha(Pasta As Workbook) Dim I As Integer Dim J As Integer For I = 1 To Pasta.Sheets.Count - 1 For J = 1 To Pasta.Sheets.Count - I - 1 If Pasta.Sheets(J).[X1] < Pasta.Sheets(J + 1).[X1] Then Call Pasta.Sheets(J + 1).Move(Pasta.Sheets(J)) End If Next J Next I End Sub

@Luiz Filipe Porto A edição que deve ser feita como comentei antes é onde os dados deve ser colados. Assim a macro cria uma aba para cada arquivo. Veja se resolve, Sub ImportaPlanilhas() Dim Arquivo As String Dim Diretorio As String Dim Pasta As Workbook Dim Planilha As Worksheet Diretorio = Environ("UserProfile") & "\Downloads\Teste\" Arquivo = Dir(Diretorio & "*.xlsx") Do Until Arquivo = "" Set Pasta = Workbooks.Open(Diretorio & Arquivo) Pasta.ActiveSheet.[A1].CurrentRegion.Copy Set Planilha = ThisWorkbook.Sheets.Add Planilha.Name = Replace(Pasta.Name, ".xlsx", "") Planilha.[A1].PasteSpecial Application.CutCopyMode = False Pasta.Close Arquivo = Dir Loop End Sub