Ajuda só para guru, com contribuição pix

[luciano piler]

Senhores bom dia, eu tenho uma planilha que preciso auditar, e ela vem assim
(exemplo em anexo)

Repare que tem item com quantidade 1, até ai tudo bem, esta ok.

O problema acontece quando tem item com quantidade 02 ou 03 ou 04... e por ai vai..

eu preciso que:
quando tiver 02 unidade ou mais , o excel repita a mesma coisa embaixo , e divida o valor

ex
codigo guia item qtd valor
39770698 90470800 Novalgina 500mg / Ml Sol . Inj . 2ml (Amp) 2,00 5,38

neste caso, ele teria que manter uma linha com a quantidade 1, repetir o codigo e numero da guia, em qt ficaria 1 e valor dividia por 2

ficando
ex
codigo guia item qtd valor
39770698 90470800 Novalgina 500mg / Ml Sol . Inj . 2ml (Amp) 1,00 2,69
39770698 90470800 Novalgina 500mg / Ml Sol . Inj . 2ml (Amp) 1,00 2,69

deu para entender? agradeço demais se me ajudar, e faço uma contribuição pela solucao

[Alyson Ronnan Martins]

Boa tarde, @luciano piler é assim que esta a sua tabela?

[luciano piler]

Sim Alyson, exatamente assim, preciso quebrar a linha 2, repetir campo A B C e quando chegar no D ficaria 1 no campo QTD e na coluna E ficaria a metade 2,69

na linha 3 ficaria a mesma coisa da linha 2, pois era 2 und! e assim sucessivamente!

[Alyson Ronnan Martins]

Fiz um teste e aparentemente esta correto.

Foi criado código para fazer a leitura do conteudo do excel olhando para a a coluna de quantidade (usando constante, dessa forma você pode adaptar para sua planilha emprecisar procurar no código aonde usar ela).

Public Sub DuplicarItemListaEDividirDinheiro()
  Dim totalLinhasPlanilha       As Long
  Dim linhaAtual                As Long
  Dim quantidadeAtual           As Long
  Dim valorNovo                 As Double
  
  Const ACRESCIMO_LINHAS        As Long = 1
  Const LINHAS_INICIAL_LOOP     As Long = 2
  Const QUANTIDADE_MIN_DIVISOR  As Long = 1
  Const COLUNA_QUANTIDADE       As String = "D"
  Const COLUNA_VALOR            As String = "E"
  
  
  'Captura a ultima linha da planilha
  totalLinhasPlanilha = fnTotalLinhas
  
  For linhaAtual = totalLinhasPlanilha To LINHAS_INICIAL_LOOP Step -ACRESCIMO_LINHAS
    'Verificar se a quantida é maior de 1
      quantidadeAtual = Cells(linhaAtual, COLUNA_QUANTIDADE).Value
      If quantidadeAtual > QUANTIDADE_MIN_DIVISOR Then
        'Dividir o valor total pela quantidade
        valorNovo = Cells(linhaAtual, COLUNA_VALOR).Value / quantidadeAtual
        
        'Inserir linha abaixo
        Rows(linhaAtual + ACRESCIMO_LINHAS & ":" & linhaAtual + quantidadeAtual - ACRESCIMO_LINHAS).Insert Shift:=xlDown
        
        'Inicial um loop
        'Caso a linha esteja vazia repete o valor da linha superior
        'Coloca o valor da quantidade pelo mínimo definido
        'Coloca o valorNovo na coloca valor
        ReplicarValorLinhaAbaixo linhaAtual, _
                                 quantidadeAtual, _
                                 QUANTIDADE_MIN_DIVISOR, _
                                 valorNovo
        
        
      End If
  Next linhaAtual
  
  
  
End Sub

Para fazer o preenchimento da linhas abaixo coloquei ou outro procedimento, só para não ficar tudo misturado:
 

Public Sub ReplicarValorLinhaAbaixo(linhaInicial As Long, quantidadeTotal As Long, quantidadeMinima As Long, novoValor As Double)
  
  Dim linhaAtual  As Long
  Dim ultimaLinha As Long
  
  Const CORRECAO_LINHA  As Long = -1
  Const COL_CODIGO      As String = "A"
  Const COL_GUIA        As String = "B"
  Const COL_ITEM        As String = "C"
  Const COL_QTD         As String = "D"
  Const COL_VALOR       As String = "E"

  
  ultimaLinha = linhaInicial + quantidadeTotal + CORRECAO_LINHA
  
  For linhaAtual = linhaInicial To ultimaLinha
    'Caso a linha não esteja preenchida pega o texto da linha superior
    If Cells(linhaAtual, COL_CODIGO).Value = "" Then
      Cells(linhaAtual, COL_CODIGO).Value = Cells(linhaAtual + CORRECAO_LINHA, COL_CODIGO).Value
      Cells(linhaAtual, COL_GUIA).Value = Cells(linhaAtual + CORRECAO_LINHA, COL_GUIA).Value
      Cells(linhaAtual, COL_ITEM).Value = Cells(linhaAtual + CORRECAO_LINHA, COL_ITEM).Value
    End If
    
    'Atualizar quantidade e valor
    Cells(linhaAtual, COL_QTD).Value = quantidadeMinima
    Cells(linhaAtual, COL_VALOR).Value = novoValor
  Next linhaAtual
  
  

End Sub

E como a planilha pode aumentar de tamanho deixei a ultima linha dinâmica fazendo uma função:
 

Public Function fnTotalLinhas() As Long
  fnTotalLinhas = Cells(Rows.Count, "A").End(xlUp).Row
End Function

 

Segue o link do arquivo excel para download e teste: SepararItemResumo.xlsm

 

Antes de processar:

Depois de processar:

[Alyson Ronnan Martins]

@luciano piler