Visual Basic Lançar pagamento parcelado na base de dados (Excel - VBA)

[Jefferson TS]

Olá. Agradeço se alguém puder me ajudar com a seguinte situação:

Tenho um formulário que receberá as informações de VALOR TOTAL, MÊS INICIAL, e QUANTIDADE DE MESES.
Preciso que estas informações sejam colocadas na base de dados estruturada com as colunas | id | data lançamento | cliente | mês competência | ano competência | valor |
Por exemplo: Dados do formulário -> cliente fulano / valor total 360 / mes início março / quant meses 3x

O exemplo acima deve ser lançado na base de dados em 3 linhas, com valor total dividido sendo 120 pra cada mês partindo de março (março abril maio).
Segue abaixo print e planilha em anexo.

CONTROLE NOVO.rar

[Midori]

@Jefferson TS Veja se é assim, fiz uma função para pegar o próximo mês com base na tabela usada na validação no mês competência.

Function ProximoMes(Mes As String) As String
    Dim IniMes      As Integer
    IniMes = WorksheetFunction.Match(Mes, [Tabela_mês], 0)
    ProximoMes = _
        WorksheetFunction.Index([Tabela_mês], IniMes Mod 12 + 1)
End Function

 

E uma sub para cadastrar na base. No mês inicio considero o formato com três letras como na tabela da validação.

Sub CadastrarCliente()
    Dim QuantMes    As Integer
    Dim Mes         As String
    
    Mes = UserFormNOVO.ComboBoxMÊSINÍCIO
    QuantMes = Val(Split(UserFormNOVO.ComboBoxQUANTMÊSES, " ")(0))
    With [Tabela_base]
        Dim Linha   As Long
        Dim I       As Integer
        For I = 1 To QuantMes
            Linha = .ListObject.ListRows.Count
            .Cells(Linha, 1) = UserFormNOVO.TextBoxID
            .Cells(Linha, 2) = UserFormNOVO.TextBoxDATA
            .Cells(Linha, 3) = Format(UserFormNOVO.TextBoxDATA, "MMMM")
            .Cells(Linha, 4) = UserFormNOVO.ComboBoxCLIENTE
            .Cells(Linha, 5) = Mes
            .Cells(Linha, 6) = UserFormNOVO.ComboBoxANO
            .Cells(Linha, 7) = (CCur(UserFormNOVO.TextBoxVALORTOTAL) / QuantMes)
            Mes = ProximoMes(Mes)
            .ListObject.ListRows.Add
        Next I
    End With
End Sub

 

[Jefferson TS]

@Midori Deu certo, porém está inserindo uma linha a mais, em branco na base de dados sempre. Sabe como fazer pra não inserir esta linha a mais?

[Midori]

@Jefferson TS Assim só vai incluir uma linha se o último lançamento de ID não tiver nenhum dado (uma tabela tem pelo menos uma linha mesmo se não tiver nenhum dado). E no loop só para a quantidade de meses.

 

With [Tabela_base]
    Dim Linha   As Long
    Dim I       As Integer
    Linha = .ListObject.ListRows.Count
    If .Cells(Linha, 1) <> "" Then Linha = Linha + 1
    For I = 1 To QuantMes
        .Cells(Linha, 1) = UserFormNOVO.TextBoxID
        .Cells(Linha, 2) = UserFormNOVO.TextBoxDATA
        .Cells(Linha, 3) = Format(UserFormNOVO.TextBoxDATA, "MMMM")
        .Cells(Linha, 4) = UserFormNOVO.ComboBoxCLIENTE
        .Cells(Linha, 5) = Mes
        .Cells(Linha, 6) = UserFormNOVO.ComboBoxANO
        .Cells(Linha, 7) = (CCur(UserFormNOVO.TextBoxVALORTOTAL) / QuantMes)
        Mes = ProximoMes(Mes)
        Linha = Linha + 1
    Next I
End With

 

[Jefferson TS]

@Midori Dá erro na parte (com 'proximoMes' destacado)

1 hora atrás, Midori disse:

Mes = ProximoMes(Mes)

 

 

Deixei o código assim:
 

Function ProximoMes(Mes As String, QuantMes As Integer) As String
    Dim IniMes      As Integer
    IniMes = WorksheetFunction.Match(Mes, [Tabela_mês], 0)
    ProximoMes = WorksheetFunction.Index([Tabela_mês], _
        (IniMes - 1 + QuantMes) Mod 12 + 1)
End Function

Sub CadastrarCliente()
    Dim QuantMes    As Integer
    Dim Mes         As String
    
    Mes = UserFormNOVO.ComboBoxMÊSINÍCIO
    QuantMes = Val(Split(UserFormNOVO.ComboBoxQUANTMÊSES, " ")(0))
    
    With [Tabela_base]
    Dim Linha   As Long
    Dim I       As Integer
    Linha = .ListObject.ListRows.Count
    If .Cells(Linha, 1) <> "" Then Linha = Linha + 1
    For I = 1 To QuantMes
        .Cells(Linha, 1) = UserFormNOVO.TextBoxID
        .Cells(Linha, 2) = UserFormNOVO.TextBoxDATA
        .Cells(Linha, 3) = Format(UserFormNOVO.TextBoxDATA, "MMMM")
        .Cells(Linha, 4) = UserFormNOVO.ComboBoxCLIENTE
        .Cells(Linha, 5) = Mes
        .Cells(Linha, 6) = UserFormNOVO.ComboBoxANO
        .Cells(Linha, 7) = (CCur(UserFormNOVO.TextBoxVALORTOTAL) / QuantMes)
        Mes = ProximoMes(Mes)
        Linha = Linha + 1
    Next I
End With

 

[Midori]

@Jefferson TS Eu tinha editado essa função, agora ela só tem um parâmetro, copie novamente.

[Jefferson TS]

@Midori Muito obrigado. Deu certo.

[Jefferson TS]

@Midori  Me deparei agora com outro problema:

Quando as parcelas passam de um ano de competência para outro, não carrega o ano.
Por exemplo: 5 parcelas começando em novembro de 2021, só terminam em 2022.

[Midori]

@Jefferson TS Uma variável pode ser usada para atribuir o ano e depois incrementada quando o próximo mês for janeiro.

 

Sub CadastrarCliente()
    Dim QuantMes    As Integer
    Dim Ano         As Integer
    Dim Mes         As String
    
    Ano = Val(UserFormNOVO.ComboBoxANOINÍCIO)
    Mes = UserFormNOVO.ComboBoxMÊSINÍCIO
    QuantMes = Val(Split(UserFormNOVO.ComboBoxQUANTMÊSES, " ")(0))
    With [Tabela_base]
        Dim Linha   As Long
        Dim I       As Integer
        Linha = .ListObject.ListRows.Count
        If .Cells(Linha, 1) <> "" Then Linha = Linha + 1
        For I = 1 To QuantMes
            .Cells(Linha, 1) = UserFormNOVO.TextBoxID
            .Cells(Linha, 2) = UserFormNOVO.TextBoxDATA
            .Cells(Linha, 3) = Format(UserFormNOVO.TextBoxDATA, "MMMM")
            .Cells(Linha, 4) = UserFormNOVO.ComboBoxCLIENTE
            .Cells(Linha, 5) = Mes
            .Cells(Linha, 6) = Ano
            .Cells(Linha, 7) = (CCur(UserFormNOVO.TextBoxVALORTOTAL) / QuantMes)
            Mes = ProximoMes(Mes)
            If Mes = "Jan" Then Ano = Ano + 1
            Linha = Linha + 1
        Next I
    End With
End Sub

 

[Jefferson TS]

@Midori Show de bola. Muuuito obrigado novamente. Tá me quebrando um galho.