Excel VBA – Criar razonetes ou contas T automaticamente

8
Excel VBA - Criar razonetes ou contas T automaticamente

Excel VBA – Criar razonetes ou contas T automaticamente

Objetivo: Disponibilizar um procedimento VBA para criar razonetes, também chamadas como Contas T de forma automática no Excel.

Conforme a Wikipédia “Nas ciências contábeisrazonete é uma ferramenta e uma representação gráfica em forma de “T” bastante utilizada pelos contadores. É um instrumento didático para desenvolver o raciocínio contábil. Através do razonete são feitos os registros individuais por conta, dispensando-se o método por balanços sucessivos. Como o balanço, o razonete tem dois lados; na parte superior do razonete coloca-se o título da conta que será movimentada. Posteriormente, os resultados individuais são transferidos para oBalanço Patrimonial para criação do demonstrativo contábil.“.

O código VBA descrito abaixo realiza a criação automática de razonetes, facilitando os estudos contábeis, acredito que possa ser muito útil para os Contadores e analistas de sistema da área.

Sub lsCriaContaT()
    ActiveCell.Resize(, 2).Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
    ActiveCell.Offset(1, 1).Select
    ActiveCell.Resize(6).Select
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
    ActiveCell.Offset(0, -1).Range("A1").Select
 
    'Gera as contas
    ActiveCell.Offset(5).Select
    ActiveCell.Resize(, 2).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
    'Fórmulas
    Selection.Resize(1, 1).Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUM(R[-5]C:R[-1]C)-SUM(R[-5]C[1]:R[-1]C[1])>0,SUM(R[-5]C:R[-1]C)-SUM(R[-5]C[1]:R[-1]C[1]),0)"
    Selection.Offset(0, 1).Select
    Selection.Resize(1, 1).Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUM(R[-5]C:R[-1]C)-SUM(R[-5]C[-1]:R[-1]C[-1])>0,SUM(R[-5]C:R[-1]C)-SUM(R[-5]C[-1]:R[-1]C[-1]),0)"
    Selection.Offset(0, -1).Select
    Selection.Resize(1, 2).Select
    Selection.Style = "Comma"
    Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
 
    Selection.Resize(1, 1).Select
    Selection.Offset(-5).Select
 
    Selection.Offset(-1).Select
    Selection.Resize(1, 2).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Selection.Font.Bold = True
End Sub
Veja também  Realçar Células no Excel - VBA
ActiveCell.Offset(1, 1).Select ActiveCell.Resize(6).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone ActiveCell.Offset(0, -1).Range("A1").Select 'Gera as contas ActiveCell.Offset(5).Select ActiveCell.Resize(, 2).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 'Fórmulas Selection.Resize(1, 1).Select ActiveCell.FormulaR1C1 = _ "=IF(SUM(R[-5]C:R[-1]C)-SUM(R[-5]C[1]:R[-1]C[1])>0,SUM(R[-5]C:R[-1]C)-SUM(R[-5]C[1]:R[-1]C[1]),0)" Selection.Offset(0, 1).Select Selection.Resize(1, 1).Select ActiveCell.FormulaR1C1 = _ "=IF(SUM(R[-5]C:R[-1]C)-SUM(R[-5]C[-1]:R[-1]C[-1])>0,SUM(R[-5]C:R[-1]C)-SUM(R[-5]C[-1]:R[-1]C[-1]),0)" Selection.Offset(0, -1).Select Selection.Resize(1, 2).Select Selection.Style = "Comma" Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
Veja também  Ponto de Equilíbrio Excel - Atingir Meta
Selection.Resize(1, 1).Select Selection.Offset(-5).Select Selection.Offset(-1).Select Selection.Resize(1, 2).Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Selection.Font.Bold = True End Sub

Para colocar o procedimento como global você deve seguir os procedimentos em http://guiadoexcel.com.br/habilitando-a-guia-desenvolvedor-e-copiando-procedimentos-vba-sub-da-internet, depois é só associar a um atalho este comando e você terá a criação automática de razonetes.

DIGITE O SEU EMAIL PARA FAZER O DOWNLOAD DOS ARQUIVOS:

Seu nome (obrigatório)

Seu e-mail (obrigatório)

Abraço

Marcos Rieper

8 COMENTÁRIOS

  1. Boa noite, tenho uma tabela de excel com cabeçalho de colunas contendo:
    1- nome da empresa
    2- nome do empregado
    3- data do exame
    4 a 17 – exames realizados (ex. hemograma, glicemia, urina, fezes, RX, etc)
    cada empresa e cada empregado fazem exames diferentes, então coloco um “X” nos exames realizados (na coluna dos exames).
    No fim do mes pego a tabela e vou trocando os “X” deacordo com uma tabela de valores dos exames (diferente valores para cada empresa. Desta feita terei de gerar um relatório de cobrança para cada empresa. O processo esta muito trabalhoso e preciso automatizar todo esse processo. Pode me ajudar? Antonio B Carvalho [email protected] tel:(19) 3844 5465

  2. Prezado Marcos Rieper, é possível fazer o lançamento no livro diário e gerar os razonetes com os valores respectivos automaticamente em VBA? Tenho uma planilha e gostaria que ela gerasse o razonete automaticamente.

    Arnaldo

  3. Bom Dia.

    Vendo que pela lógica foi apenas uma exemplificação, porém, não muito feliz com a conta de Clientes, acredito que isso tem influência em relação á estudantes que ainda conceituam os saldos devedores e credores.

    Ótimo material e colocação, excelente site.

    • Boa tarde Alan,

      Hehe, realmente não é para ter lógica, era somente pra demonstrar que a conta T já automaticamente está colocando o saldo para um lado ou para outro.

      Mas realmente poderia ter sido feito com um exemplo contábil.

      Abraço

      Marcos Rieper

DEIXE UMA RESPOSTA

Please enter your comment!
Please enter your name here