Excel Distribuir parcelas do cartão com a diferença na primeira parcela

[riberex00]

Boa noite pessoal. Como

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

mudar o código abaixo (distribuição das parcelas do cartão de credito), para que a diferenca seja na primeira parcela? Obrigado.

[Midori]

@riberex00 Faltou anexar a planilha onde seja possível testar o código e com exemplos do resultado esperado. Pode ser com dados fictícios.

[riberex00]

Boa tarde meu amigo. Não da para anexar com o Winrar, só com o zip, certo? 

[OreiaG]

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.

[riberex00]

Redondinho agora. Obrigado pela dica.