Boa noite pessoal. Como mudar o código abaixo (distribuição das parcelas do cartão de credito), para que a diferenca seja na primeira parcela? Obrigado.
Option Explicit
Private Sub Btn_Executar_Click()
Dim Lin As Long 'Controlar Nr de parcelas
Dim Col As Integer 'Colu onde info sera inserida
Dim QteParc As Byte 'Controlar parcelas
Dim Valor As Currency 'Valor Tot
Dim ValorParc As Currency 'Valor cada parcela
Dim Dif As Currency 'Armaz dif nos valores
Dim W As Worksheet 'Var Ctrl para manipular a planilha
Dim A As Integer 'Var Loop
Set W = Planilha1
W.Range("D:E").Clear 'Apaga valores anteriores
'Captura valor do problema
QteParc = W.Range("B1").Value
Valor = W.Range("B2").Value
Lin = 1
Col = 4
'Valor da parcela ' Valor sem casas decimais: FIX
' Valor com casas decimais: ROUND
ValorParc = Round(Valor / QteParc, 2)
'Calcular a dif se existir
If Valor <> (ValorParc * QteParc) Then
Dif = Valor - (ValorParc * QteParc)
End If
'Rotina p/ Add a dif
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
MsgBox "Pronto!"
End Sub
Pergunta
riberex00
Boa noite pessoal. Como mudar o código abaixo (distribuição das parcelas do cartão de credito), para que a diferenca seja na primeira parcela? Obrigado.
Option Explicit Private Sub Btn_Executar_Click() Dim Lin As Long 'Controlar Nr de parcelas Dim Col As Integer 'Colu onde info sera inserida Dim QteParc As Byte 'Controlar parcelas Dim Valor As Currency 'Valor Tot Dim ValorParc As Currency 'Valor cada parcela Dim Dif As Currency 'Armaz dif nos valores Dim W As Worksheet 'Var Ctrl para manipular a planilha Dim A As Integer 'Var Loop Set W = Planilha1 W.Range("D:E").Clear 'Apaga valores anteriores 'Captura valor do problema QteParc = W.Range("B1").Value Valor = W.Range("B2").Value Lin = 1 Col = 4 'Valor da parcela ' Valor sem casas decimais: FIX ' Valor com casas decimais: ROUND ValorParc = Round(Valor / QteParc, 2) 'Calcular a dif se existir If Valor <> (ValorParc * QteParc) Then Dif = Valor - (ValorParc * QteParc) End If 'Rotina p/ Add a dif 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 MsgBox "Pronto!" End Sub
Link para o comentário
Compartilhar em outros sites
0 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.