如何解决填充两个日期之间的所有月份
我一直在尝试在 Excel 中创建一个公式来填充两个日期之间的月份。
我得到的只是 DatedIF() 但它不满足要求。
这是我想要的 Excel 公式图片。如果我更新开始日期或结束日期公式中的任何日期，将自动计算日期之间的所有月份，并给出附加图片中可用的结果。
=IF(ROW()=15,IFERROR(INDEX(MONTH(EDATE(Sheet1!B$4,ROW(A$15:INDEX(A:A,DATEDIF(Sheet1!B$4,Sheet1!G$1,"m"))))),COUNT(A$15:A15)),""))
解决方法
这将从第 5 行开始填充。毫无疑问，该代码可以用作数组公式。
Sub Test()
With ThisWorkbook.Worksheets("Sheet1")
PopulateMonths .Range("B2"),.Range("B3")
End With
End Sub
Sub PopulateMonths(FirstDate As Range,SecondDate As Range)
Dim MonthCount As Long
MonthCount = DateDiff("m",FirstDate,SecondDate)
With ThisWorkbook.Worksheets("Sheet1")
'This will clear from row 5,column 1 to the last piece of data in column 1.
'If column 1 is already empty it will clear from A1:A5,so best to check if
'there's any data to clear before this line runs (just see if A5<>"")
.Range(.Cells(5,1),.Cells(.Rows.Count,1).End(xlUp)).ClearContents
Dim x As Long
For x = 0 To MonthCount
.Cells(x + 5,1) = x 'Start on row 5,column 1.
Next x
End With
End Sub
你可以试试：
A4 中的公式：
=IF(ROW()=4,IFERROR(INDEX(MONTH(EDATE(B$1,ROW(A$1:INDEX(A:A,DATEDIF(B$1,B$2,"m"))))),COUNT(A$3:A3)),""))
向下拖动。
注意：例如，如果结束日期为“30-12-2021”，则最多只能使用 11。如果您仍希望看到最多 12，则需要使用 {{1} } 作为嵌套函数在那里。
,填充两个日期之间的月份
- 以下是使用
Worksheet Change event的自动版本，即它仅在您手动或通过VBA更改值（不是通过公式）时运行。您无需运行任何程序，只需将代码复制到适当的模块并调整常量部分中的值即可。 - 如果因为某些原因不想自动化，可以删除sheet模块中的代码，删除标准模块中
Option Explicit下面的三个常量，取消populateMonths中三个常量的注释.现在它只适用于populateMonthsInit。 - 如果开始日期是该月的最后一天，则不会包括该月份。同样，如果结束日期是该月的第一个日期，则不会包括该月份。这可以轻松调整。
工作表模块例如Sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Union(Range(StartDateCell),Range(EndDateCell)),Target)
If Not rng Is Nothing Then
populateMonths
End If
End Sub
标准模块Module1
Option Explicit
Public Const StartDateCell As String = "B1"
Public Const EndDateCell As String = "B2"
Private Const FirstCell As String = "B4"
Sub populateMonthsInit()
populateMonths
End Sub
Sub populateMonths(Optional ws As Worksheet)
'Const StartDateCell As String = "B1"
'Const EndDateCell As String = "B2"
'Const FirstCell As String = "B4"
If ws Is Nothing Then
Set ws = ThisWorkbook.ActiveSheet
End If
With ws.Range(FirstCell)
Dim Data As Variant
Data = getMonthNumbers(.Worksheet.Range(StartDateCell).Value,_
.Worksheet.Range(EndDateCell).Value)
.Resize(.Worksheet.Rows.Count - .Row + 1).ClearContents
.Value = 0 ' Not sure what that's all about.
If Not IsEmpty(Data) then
.Offset(1).Resize(UBound(Data,1)).Value = Data
End if
End With
End Sub
Function getMonthNumbers( _
ByVal StartDate As Date,_
ByVal EndDate As Date) _
As Variant
On Error GoTo clearError
Dim Months As Long: Months = DateDiff("m",StartDate,EndDate)
Dim StartMonth As Long
If Month(StartDate + 1) = Month(StartDate) Then
Months = Months + 1
StartMonth = modMonth(Month(StartDate))
Else
StartMonth = modMonth(Month(StartDate) + 1)
End If
If Month(EndDate - 1) <> Month(EndDate) Then
Months = Months - 1
End If
Dim Data() As Long: ReDim Data(1 To Months,1 To 1)
Data(1,1) = StartMonth
Dim i As Long
For i = 2 To Months
Data(i,1) = modMonth(Data(i - 1,1) + 1)
Next i
getMonthNumbers = Data
ProcExit:
Exit Function
clearError:
Resume ProcExit
End Function
Function modMonth( _
m As Long) _
As Long
modMonth = IIf(m Mod 12,m Mod 12,12)
End Function
Sub TESTgetMonthNumbers()
Dim Data As Variant: Data = getMonthNumbers(Range("B1"),Range("B2"))
If Not IsEmpty(Data) Then
Debug.Print Join(Application.Transpose(Data),vbLf)
Else
Debug.Print "Nope."
End If
End Sub
即使您有一个非常简单的公式的 Excel 版本，您也可以使用它。
在 D11 =TEXT($D$5,"MM")
在 D12 =IF(D11=12,1,TEXT($D$5,"MM")+D11) 中并向下拖动。
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
