Página 1 de 1

Codigo VBA p/ parcelamento

Enviado: 23 Ago 2021 às 19:17
por DennerSantos
Galerinha preciso de uma ajuda, nao manjo muito de excel vba mais fiz umas coisas pesquisando na net so que to fazendo uma planilha que puxa lançamento do cartao em uma planilha e joga na outra atraves de um botao quando clicado porem eu queria que ele pegasse esses dados e multiplicasse pelo numero de parcela e colocasse na planilha, sera que é possivel? segue meu codigo
Código: Selecionar todos
Sub relatorio()
    Plan6.Range("A7:i1500").ClearContents
    ultimalinha = Planilha1.Cells(Rows.Count, "a").End(xlUp).Row
    lin = 7
    For i = 2 To ultimalinha
        If Planilha1.Cells(i, 1) = "Saida" Then
        If Planilha1.Cells(i, 2) = "Emprestimo" Then
            Plan6.Cells(lin, 1) = Planilha1.Cells(i, 1) 'Movimento
            Plan6.Cells(lin, 2) = Planilha1.Cells(i, 3) 'Status
            Plan6.Cells(lin, 3) = DateValue(Format(Planilha1.Cells(i, 4), "mm/dd/yyyy")) 'data
            Plan6.Cells(lin, 4) = DateValue(Format(Planilha1.Cells(i, 5), "mm/dd/yyyy")) 'Vencimento
            Plan6.Cells(lin, 5) = Planilha1.Cells(i, 7) 'Pessoa
            Plan6.Cells(lin, 6) = Planilha1.Cells(i, 8) 'Descrição
            Plan6.Cells(lin, 8) = Planilha1.Cells(i, 6) 'Parcela
            Plan6.Cells(lin, 9) = Planilha1.Cells(i, 9) 'Saida
            Plan6.Cells(lin, 12) = Planilha1.Cells(i, 14) 'Resolvido
            lin = lin + 1
           End If
        End If
        
          If Planilha1.Cells(i, 1) = "Recebimento" Then
        If Planilha1.Cells(i, 2) = "Emprestimo" Then
            Plan6.Cells(lin, 1) = Planilha1.Cells(i, 1) 'Movimento
            Plan6.Cells(lin, 2) = Planilha1.Cells(i, 3) 'Status
            Plan6.Cells(lin, 3) = DateValue(Format(Planilha1.Cells(i, 4), "mm/dd/yyyy")) 'data
            Plan6.Cells(lin, 5) = Planilha1.Cells(i, 7) 'Pessoa
            Plan6.Cells(lin, 6) = Planilha1.Cells(i, 8) 'Descrição
            Plan6.Cells(lin, 7) = Planilha1.Cells(i, 9) 'Entrada
            Plan6.Cells(lin, 12) = Planilha1.Cells(i, 14) 'Resolvido
            lin = lin + 1
            End If
        End If
        
    Next
End Sub
um exemplo melhor la lanço

uma compra de R$ 1000,00 e parcela de 6x

e lança na planilha cada parcela no seu dia com mês de vencimento seria muito grato

Re: Codigo VBA p/ parcelamento

Enviado: 23 Ago 2021 às 23:55
por osvaldomp
Olá, @DennerSantos .

Sugestão: disponibilize uma amostra do seu arquivo Excel com alguns exemplos, com o código atual instalado e com o resultado desejado.

Re: Codigo VBA p/ parcelamento

Enviado: 24 Ago 2021 às 10:09
por DennerSantos
Desculpe tinha anexado porem nao subiu segue agora
Teste Planilha.xlsm

Re: Codigo VBA p/ parcelamento

Enviado: 24 Ago 2021 às 10:32
por osvaldomp
osvaldomp escreveu: 23 Ago 2021 às 23:55 Olá, @DennerSantos .

Sugestão: disponibilize uma amostra do seu arquivo Excel com alguns exemplos, com o código atual instalado e com o resultado desejado.
#
Não encontrei o resultado desejado com as necessárias explicações. :?:

Re: Codigo VBA p/ parcelamento

Enviado: 24 Ago 2021 às 11:25
por DennerSantos
vamos ver se eu consigo explicar...

Na planilha A(LANÇAMENTO) eu vou lançar as compras la vou lançar o valor total, vencimento e quantas parcelas e quando eu clicar no botão "lançar" na planilha B(RECEBIMENTO) ele lançar nas linhas abaixo as parcelas uma a uma em cada linha com o vencimento e o valor dividido pela quantidade de parcela
Teste Planilha.xlsm

Re: Codigo VBA p/ parcelamento

Enviado: 24 Ago 2021 às 12:01
por osvaldomp
Confirme se os dados que você colocou na planilha Recebimento representam o resultado desejado.

Re: Codigo VBA p/ parcelamento

Enviado: 24 Ago 2021 às 13:59
por DennerSantos
os dados que estão na planilha recebimento esta puxando exatamente como esta na planilha lançamentos vou colocar em anexo como eu queria que ficasse

Teste Planilha.xlsm

Re: Codigo VBA p/ parcelamento

Enviado: 24 Ago 2021 às 19:34
por osvaldomp
Código: Selecionar todos
Sub ReplicaDados()
 Dim mov As Range, i As Long
  Application.ScreenUpdating = False
  If Sheets("Recebimento").[A7] <> "" Then
   Sheets("Recebimento").Range("A7:I" & Sheets("Recebimento").Cells(Rows.Count, 1).End(3).Row).Value = ""
  End If
  With Sheets("Lançamentos")
   On Error Resume Next
   .ShowAllData
   On Error GoTo 0
   .[A6:I6].AutoFilter 1, "Saida"
   If .AutoFilter.Range.Columns(1).SpecialCells(12).Count > 1 Then
    For Each mov In .Range("A7:A" & .Cells(Rows.Count, 1).End(3).Row).SpecialCells(12)
     mov.Resize(, 3).Copy
     Sheets("Recebimento").Cells(Rows.Count, 1).End(3)(2).Resize(mov.Offset(, 4).Value).PasteSpecial xlValues
     mov.Offset(, 5).Resize(, 2).Copy
     Sheets("Recebimento").Cells(Rows.Count, 5).End(3)(2).Resize(mov.Offset(, 4).Value).PasteSpecial xlValues
     mov.Offset(, 3).Copy
     Sheets("Recebimento").Cells(Rows.Count, 4).End(3)(2).PasteSpecial xlValues
     For i = 1 To mov.Offset(, 4).Value
      Sheets("Recebimento").Cells(Rows.Count, 4).End(3)(1 - (i > 1) * 1).Value = DateAdd("m", i - 1, mov.Offset(, 3))
      Sheets("Recebimento").Cells(Rows.Count, 8).End(3)(2).Value = "'" & i & "/" & mov.Offset(, 4).Value
      Sheets("Recebimento").Cells(Rows.Count, 9).End(3)(2).Value = mov.Offset(, 7).Value / mov.Offset(, 4).Value
     Next i
    Next mov
   End If
   .ShowAllData
  End With
End Sub