OreiaG

Se você ainda tem interesse na solução que você solicitou, coloque a fórmula abaixo em C2. =SE(ÉPAR(INT((B2-A2-1)/12));"PROG "&SE(MOD(B2-A2;12)=0;12;MOD(B2-A2;12));"REGR "&MOD(INT(A2-B2+12);12)+1) Como complemento, você pode aplicar Formatação Condicional em C2: Regra1 >>> =ESQUERDA($C$2;1)="R" >>> formate a célula ou a fonte para vermelho Regra2 >>> =ESQUERDA($C$2;1)="P" >>> formate a célula ou a fonte para verde

Substitua esta linha >>> WH.Range("B1:L" & Cells(Rows.Count, "L").End(xlUp).Row).Select por esta >>> WH.Range("B1:L11").Select

Veja se atende. Columns(5).TextToColumns , FieldInfo:=Array(1, 4) 'coluna E Columns(6).TextToColumns , FieldInfo:=Array(1, 4) 'coluna F

Segue outra solução que funciona também se A1 contiver mais de 35 caracteres. Function separa(c As Range) separa = Trim(Format(c.Value, """" & """" & Application.Rept("@@@@@ ", Application.Max(Len(c.Value) / 5, 1)) & """" & """")) End Function

=desloc(peso_exemplo!$b$1;corresp($a3;peso_exemplo!$b:$b;0)-1;corresp(f$2;peso_exemplo!$7:$7;0)-2)

Cole esta UDF em um módulo. Function separa(c As Range) separa = Trim(Format(c.Value, "@@@@@ @@@@@ @@@@@ @@@@@ @@@@@ @@@@@ @@@@@")) End Function Em B1 coloque >>> =separa(A1) e arraste para baixo se houver dados abaixo de A1.

=cont.núm(a1:a5)*3

Experimente >>> Replacement:=UCase(sSubs)

Considerei: -- lista dos nomes na coluna B a partir de B1, com qualquer quantidade de nomes -- em D1 o nome a ser procurado -- em E1 a quantidade de linhas a inserir Sub InsereLinhas() Dim c As Range Set c = Range("B1:B" & Cells(Rows.Count, 2).End(3).Row).Find([D1], SearchDirection:=xlPrevious, SearchOrder:=xlByRows) If Not c Is Nothing Then Rows(c.Row + 1).Resize([E1]).Insert End If End Sub

Experimentaram estas opções do Google ? remover conta do Teams

Substitua esta linha Dif = Valor - (ValorParc * QteParc) por esta Dif = Valor - ValorParc * (QteParc - 1) E substitua este trecho For A = 1 To QteParc W.Cells(Lin, Col).Value = "'" & A & "/" & QteParc If A = QteParc Then W.Cells(Lin, Col + 1).Value = ValorParc Else W.Cells(Lin, Col + 1).Value = ValorParc + Dif End If Lin = Lin + 1 Next Por este For A = 1 To QteParc W.Cells(Lin, Col).Value = "'" & A & "/" & QteParc If A = 1 Then W.Cells(Lin, Col + 1).Value = IIf(Dif <> 0, Dif, ValorParc) Else W.Cells(Lin, Col + 1).Value = ValorParc End If Lin = Lin + 1 Next A obs. alterei no código a forma de calcular a diferença (a ser colocada na primeira parcela), pois há casos em que o seu código não faz bater a soma das parcelas com o valor da compra. Exemplo: 500,00 em 3 ou em 7 parcelas.

É improvável o Loop sem fim. Você experimentou deixar processar? Às vezes o Excel mostra Não está respondendo, mas ele continua processando até encerrar a execução. Se possível anexe o arquivo para testarmos.

Isso mesmo. Por exemplo, em ITEM 01!B152 >>> =TRUNCAR(B151/D67;2) Na célula será exibido 5,58 e se fizer Copiar/Colar Valores o valor colado será também 5,58. Como alternativa você pode fazer referência às células de origem dos valores, em lugar de replicar manualmente o valor mostrado na célula. Por exemplo, em PROPOSTA INICIAL!I3, em lugar de 5,58 coloque >>> ='ITEM 01'!B152

O CUSTO TOTAL KM/RODADO não é 5,58. Esse valor é o valor exibido na célula (ITEM 01!B152), porém o valor real é 5,5834050376095 e por isso os valores não batem. Para verificar copie de ITEM 01!B152 e cole em qualquer célula vazia como Colar Valores. Você consegue resolver essas diferenças utilizando nas suas fórmulas uma das funções de arredondamento ou a função TRUNCAR(). EDIT: cheguei atrasado para a festa.

Hummm ... possivelmente algum SKU não tem data em final de semana. Essa situação não foi prevista. Para evitar o erro, por favor, acrescente as duas linhas em vermelho conforme abaixo. LR = Cells(Rows.Count, 20).End(3).Row On Error GoTo nxtk For Each r In rng.SpecialCells(2, 1) e Next r nxtk: On Error GoTo -1 Next x

Eu constatei os erros que você apontou. Eles ocorrem porque eu escrevi o código para o primeiro arquivo que você postou, e neste último que você anexou existem situações não previstas no primeiro. Fiz os ajustes para processar o arquivo mais recente. Por favor veja se os resultados estão corretos. Abaixo segue uma imagem com os dados antes e depois de rodar o código. As diferenças na numeração das linhas do "antes" para o "depois" é por conta da exclusão das linhas, que passam de 31 para 22 linhas com dados após rodar o código. Sub TrataVolumesV2() Dim r As Range, rng As Range, UL As Long, k As Long, v As Double Dim dat(), dict As Object, y As Long, x, LR As Long, z As Double Application.ScreenUpdating = False On Error Resume Next ActiveSheet.ShowAllData On Error GoTo 0 [U:U] = "" UL = Cells(Rows.Count, 1).End(3).Row Range("A2:U" & UL).Sort Key1:=[A2], order1:=xlAscending, Key2:=[I2], order2:=xlAscending Set dict = CreateObject("Scripting.Dictionary") dat = Range("A2:A" & Cells(Rows.Count, 1).End(3).Row).Value2 For y = 1 To UBound(dat) dict(dat(y, 1)) = Empty Next y With Range("U2:U" & UL) .FORMULA = "=IF(AND(DAY(I2)=1,WEEKDAY(I2)=7),""sáb1"",IF(WEEKDAY(I2,2)>5,""fds"",IF(AND(I3<>"""",WEEKDAY(I3,2)>5),1,"""")))" .Value = .Value For Each x In dict.keys ActiveSheet.[A1:U1].AutoFilter 1, x Set rng = ActiveSheet.AutoFilter.Range.Columns(21).SpecialCells(12) LR = Cells(Rows.Count, 20).End(3).Row For Each r In rng.SpecialCells(2, 1) Do While r.Row <= LR And r.Offset(k + 1) <> "" And Application.IsText(r.Offset(k + 1)) v = v + r.Offset(k + 1, -10): z = z + r.Offset(k + 1, -11) k = k + 1 Loop If r.Offset(1) = "fds" Then r.Offset(, -10) = r.Offset(, -10) + v r.Offset(, -11) = r.Offset(, -11) + z Else: r.Offset(k + 1, -10) = r.Offset(k + 1, -10) + v r.Offset(k + 1, -11) = r.Offset(k + 1, -11) + z End If v = 0: z = 0 Rows(r.Row + 1).Resize(k).Delete k = 0 Next r Next x End With ActiveSheet.ShowAllData [U:U] = "" End Sub

Se você quiser testar esta opção. Eu gostaria de saber sobre o desempenho deste código ao tratar as 600+ linhas. Pode aplicar nos dados brutos, não é necessário ordenar, o código irá ordenar por sku/data. Sub TrataVolumes() Dim r As Range, rng As Range, UL As Long, k As Long, v As Double Dim dat(), dict As Object, y As Long, x, LR As Long, z As Double Application.ScreenUpdating = False On Error Resume Next ActiveSheet.ShowAllData On Error GoTo 0 [U:U] = "" UL = Cells(Rows.Count, 1).End(3).Row Range("A2:T" & UL).Sort Key1:=[A2], order1:=xlAscending, Key2:=[I2], order2:=xlAscending Set dict = CreateObject("Scripting.Dictionary") dat = Range("A2:A" & Cells(Rows.Count, 1).End(3).Row).Value2 For y = 1 To UBound(dat) dict(dat(y, 1)) = Empty Next y With Range("U2:U" & UL) .Formula = "=IF(AND(DAY(I2)=1,WEEKDAY(I2)=7),""sáb1"",IF(WEEKDAY(I2,2)>5,""fds"",IF(AND(I3<>"""",WEEKDAY(I3,2)>5),1,"""")))" .Value = .Value For Each x In dict.keys ActiveSheet.[A1:T1].AutoFilter 1, x Set rng = ActiveSheet.AutoFilter.Range.Columns(21).SpecialCells(12) LR = Cells(Rows.Count, 20).End(3).Row For Each r In rng.SpecialCells(2, 1) Do While r.Row <= LR And r.Offset(k + 1) <> "" v = v + r.Offset(k + 1, -10): z = z + r.Offset(k + 1, -11) k = k + 1 Loop If r.Offset(1) = "fds" Then r.Offset(, -10) = r.Offset(, -10) + v r.Offset(, -11) = r.Offset(, -11) + z Else: r.Offset(k + 1, -10) = r.Offset(k + 1, -10) + v r.Offset(k + 1, -11) = r.Offset(k + 1, -11) + z End If v = 0: z = 0 Rows(r.Row + 1).Resize(k).Delete k = 0 Next r Next x End With ActiveSheet.ShowAllData [U:U] = "" End Sub

A parte em vermelho pode ser reduzida. =SE(OU(DIA.DA.SEMANA(H$5;11)=6;DIA.DA.SEMANA(H$5;11)=7);" ";SE(E($D6<>"";$E6<>"";H$5>=$D6;H$5<=$E6);"(*)";"<x>")) =SE(DIA.DA.SEMANA(H$5;2)>5;" ";SE(E($D6<>"";$E6<>"";H$5>=$D6;H$5<=$E6);"(*)";"<x>"))

Seria mais fácil obter alguma sugestão se você anexar aqui o seu arquivo Excel com a fórmula em questão e as explicações.

Veja se ajuda. =TEXTO(C1;"dd/mm/aaaa")&" - CONCURSO - "&DIATRABALHOTOTAL.INTL(A1;C1;"1010101")+B1-1

O seu print mostra que a célula selecionada é U13, então a fórmula naquela célula deveria ser =SE(B13; ... no entanto a fórmula é =SE(B10; ... Cole em U10 a fórmula que eu postei e depois arraste até U19.

Em qual coluna de qual planilha você testou ? Testei a fórmula abaixo em NECESSIDADES!U10:U19 e funciona corretamente, ou seja, ela retorna vazio enquanto a fórmula da coluna B não retornar uma data. =SE(B10>0;PROCV($B$5;'H. NECESSIDADES'!$A$2:$LZ$8;13;0);"") alerta - células mescladas poderão apresentar problemas na planilha.

Veja se ajuda. =SE(B10>0;PROCV($B$5;'H. NECESSIDADES'!$A$2:$LZ$8;13;0);"")

Considerando que você quer extrair a data sem a hora. 1. se as datas da coluna A forem datas reais, cole em B2 e arraste para baixo >>> =INT(A2) 2. se as datas da coluna A forem texto, e não datas reais, cole em B2 e arraste para baixo >>> =SUBSTITUIR(ESQUERDA(A2;NÚM.CARACT(A2)-10);" de ";"/")+0 Para saber se são datas reais ou texto, cole esta fórmula em qualquer célula vazia >>> =ÉNÚM(A2) VERDADEIRO >>> é data real, e FALSO >>> é texto. Formate a coluna B >>> Formatar células >>> Data >>> *14/03/2012. Para substituir as fórmulas pelos seus respectivos valores >>> selecione todas >>> Copiar >>> Colar Valores. Em seguida você poderá excluir a coluna A.

No entanto, se você quer remover a hora e deixar somente a data, essa operação não se trata de mera formatação. Para conseguir você vai precisar de uma coluna auxiliar com fórmula, ou macro, sem coluna auxiliar.