Criar uma Tabela

[Gustavo Viana]

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

Abraços

[Erik Wesley]

Talvez se você postar o código que já tem, podemos otimiza-lo.

[Gustavo Viana]

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

[Erik Wesley]

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.

Editado Junho 21, 2018 por Erik Wesley

[Gustavo Viana]

Cara ficou muito bom! Obrigado mesmo!!!

[Erik Wesley]

  Em 16/07/2018 em 16:27, Gustavo Viana disse:

Cara ficou muito bom! Obrigado mesmo!!!

Expand  

Disponha!

[ernesto_ss]

Realmente Magnífico