excel 输入年份后如何添加月份列表?

am46iovg  于 2023-03-13  发布在  其他
关注(0)|答案(3)|浏览(190)

我正在尝试生成一个月的列表后,我输入了一年,并点击按钮。
如果输入2024年,则生成的月份应为2024年4月至2025年3月。

我录制了一个宏。如何使代码灵活?

Sub GenerateAmot()
'
' GenerateAmot Macro
'

'
    ActiveCell.FormulaR1C1 = "2024"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "4/1/2024"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "5/1/2024"
    Range("F5").Select
    ActiveCell.FormulaR1C1 = "6/1/2024"
    Range("F6").Select
    ActiveCell.FormulaR1C1 = "7/1/2024"
    Range("F7").Select
    ActiveCell.FormulaR1C1 = "8/1/2024"
    Range("F8").Select
    ActiveCell.FormulaR1C1 = "9/1/2024"
    Range("F9").Select
    ActiveCell.FormulaR1C1 = "10/1/2024"
    Range("F10").Select
    ActiveCell.FormulaR1C1 = "11/1/2024"
    Range("F11").Select
    ActiveCell.FormulaR1C1 = "12/1/2024"
    Range("F12").Select
    ActiveCell.FormulaR1C1 = "1/1/2025"
    Range("F13").Select
    ActiveCell.FormulaR1C1 = "2/1/2025"
    Range("F14").Select
    ActiveCell.FormulaR1C1 = "3/1/2025"
    Range("F15").Select
End Sub
nafvub8i

nafvub8i1#

下面的代码从输入框中获取年份,并用月份填充您指定的单元格。

Sub Fill_Months()
Dim strYear As String, a As Long
strYear = InputBox("Enter the year", , Year(Date))

ActiveCell.FormulaR1C1 = strYear
For a = 1 To 12
    Range("F" & a + 2).FormulaR1C1 = Format(DateAdd("m", 3, DateSerial(CLng(strYear), a, 1)), "m/d/yyyy")
Next
End Sub
xuo3flqw

xuo3flqw2#

您可以使用VBA:

Sub createMonthsForYear(lngYear As Long, rgTarget as Range)

Dim i As Long, arrDates(1 To 12, 1 To 1) As Variant

For i = 1 To 12
    arrDates(i, 1) = DateSerial(lngYear, 3 + i, 1)
Next

rgTarget.Resize(12).Value = arrDates

End Sub

你可以这样称呼这个潜艇:

createMonthsForYear 2024, ActiveSheet.Range("F4")

或者您可以使用公式-如果您使用Excel 365

= DATE(B1,SEQUENCE(12,1,4,1),1)

nwlqm0z1

nwlqm0z13#

每月生成

Sub GenerateMonthlyFill()
    
    If ActiveSheet Is Nothing Then Exit Sub ' no visible workbooks open
    If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
    
    With ActiveSheet
        FillMonthly .Range("A3"), .Range("B1"), 4, , , "MMMM-YY"
    End With
    
End Sub

Sub FillMonthly( _
        ByVal FirstCell As Range, _
        ByVal FirstYear As Long, _
        Optional ByVal FirstMonth As Long = 1, _
        Optional ByVal FirstDay As Long = 1, _
        Optional ByVal MonthsCount As Long = 12, _
        Optional ByVal DateFormat As String = "YYYY-MM-DD")
    
    Dim Data(): ReDim Data(1 To MonthsCount, 1 To 1)
    Dim CurrDate As Date: CurrDate = DateSerial(FirstYear, FirstMonth, FirstDay)
    
    Dim r As Long
    
    For r = 1 To MonthsCount
        Data(r, 1) = "'" & Application.Text(CurrDate, DateFormat)
        CurrDate = DateAdd("m", 1, CurrDate)
    Next r

    Dim drg As Range: Set drg = FirstCell.Resize(MonthsCount)
    drg.Value = Data

End Sub

相关问题