• 0
Sign in to follow this  
Gustavo Viana

Criar uma Tabela

Question

Bom dia pessoal,

Quero automatizar uma tabela para investimentos, onde eu entro com o primeiro ano de investimentos e com o último, e ele gera uma tabela parecida com essa, gostaria de saber se alguém sabe como ou tem um código parecido no vba

image.png.d7a49e11cd4feca98c51db203db2af42.png

Abraços

image.png

Share this post


Link to post
Share on other sites

6 answers to this question

Recommended Posts

  • 0

Então, eu consegui fazer isso que eu estava falando, agora eu preciso fazer com que apareça o ano nas células mescladas. até o momento o código está assim:

 

Sub Investimento()

mes1 = InputBox("Insira o Mês do Primeiro Investimento: ")
Range("C4").Value = mes1
ano1 = InputBox("Insira o Ano do Primeiro Investimento: ")
Range("D4").Value = ano1
mes2 = InputBox("Insira o Mês do Último Investimento: ")
Range("C5").Value = mes2
ano2 = InputBox("Insira o ano do Último Investimento: ")
Range("D5").Value = ano2
Primeiro = Range("D4").Value
Ultimo = Range("D5").Value

anos = Ultimo - Primeiro
 For i = 1 To anos + 1
 
    ActiveCell.Range("A1:L1").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
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Jan"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Fev"
    ActiveCell.Offset(0, -1).Range("A1:B1").Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:L1"), Type:= _
        xlFillDefault
    ActiveCell.Range("A1:L1").Select
    ActiveCell.Offset(-1, 0).Range("A1:L3").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
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    ActiveCell.Offset(3, 0).Range("A1").Select
    Next
End Sub
 

Obrigado

Share this post


Link to post
Share on other sites
  • 0
Sub Investimento()

Dim anocelula As String


mes1 = InputBox("Insira o Mês do Primeiro Investimento: ")
If mes1 = "" Then
Exit Sub
End If
Range("C4").Value = mes1
Ano1 = InputBox("Insira o Ano do Primeiro Investimento: ")
Range("D4").Value = Ano1
mes2 = InputBox("Insira o Mês do Último Investimento: ")
Range("C5").Value = mes2
ano2 = InputBox("Insira o ano do Último Investimento: ")
Range("D5").Value = ano2
Primeiro = Range("D4").Value
Ultimo = Range("D5").Value

anos = Ultimo - Primeiro
 
anocelula = Primeiro
 
 For i = 1 To anos + 1
 
    ActiveCell.Range("A1:L1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    ActiveCell.Value = anocelula
    
    anocelula = anocelula + 1
    
    Selection.Merge
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Jan"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Fev"
    ActiveCell.Offset(0, -1).Range("A1:B1").Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:L1"), Type:= _
        xlFillDefault
    ActiveCell.Range("A1:L1").Select
    ActiveCell.Offset(-1, 0).Range("A1:L3").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
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    ActiveCell.Offset(3, 0).Range("A1").Select
    Next
End Sub

 

 

Tente agora. 

 

Só depois de muito tempo que entendi oque precisava.

Inclui também uma condicional caso você decida cancelar a ação, agora ele não vai rodar sem informações.

Edited by Erik Wesley

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this