我需要自動計算5 年前的開始日期（又名 QRT_START） 。一個季度是 3 個月。例如，一年有 4 個季度：3 月 31 日、6 月 30 日、9 月 30 日和 12 月 31 日。??
由于我們目前是 2022 年 11 月 16 日，開始日期將是 2017 年 12 月 31 日。因此，無論當前日期是什么，開始日期都需要回溯 5 年的季度。
我還需要自動計算最近的結束日期（又名 QRT_END）。因此，由于我們是 2022 年 11 月 16 日，結束日期將是今天之前的上一季度結束，即 2022 年 9 月 30 日。我有下面寫的 VBA 代碼，請幫我修復。
Private Function getQRT_END() As String?
Dim endmonth As Variant
Dim endyear As Variant
Dim Day As Variant
endmonth = Month(Date) - 1
If endmonth = 0 Then
endyear = Year(Date) - 1
endmonth = 12
day = 31
Else
endyear = Year(Date)
If endmonth = 3 Then
day = 31
Else
day = 30
End if
endmonth = “0” & endmonth
End If
getQRT_END = endyear & endmonth & day
End Function
Private Function getQRT_START() As String
Dim startmonth As Variant
Dim startyear As Variant
Dim Day As Variant
startyear = Year(Date) - 5
startmonth = Month(Date) 2
If startmonth <10 Then
If startmonth = 3 Then
day = 31
Else
day = 30
End if
startmonth = “0” & startmonth
Else
day = 30
End If
getQRT_START = startyear & startmonth & day
End Function
uj5u.com熱心網友回復：
Function GetQuartal(years, data)
d = DateAdd("yyyy", years, data)
q = (Month(d) 2) \ 3
qstart = DateSerial(Year(d), (q - 1) * 3 1, 1)
qend = DateSerial(Year(d), q * 3 1, 1) - 1
GetQuartal = Array(data, d, qstart, qend)
End Function
Sub test()
Debug.Print "Date", "Date-5Y", "QY-5 Start", "QY-5 End"
For Each d In Array(Date, #2/29/2000#, #12/1/2021#, #5/5/1992#)
q = GetQuartal(-5, d)
Debug.Print q(0), q(1), q(2), q(3)
Next
End Sub
Date Date-5Y QY-5 Start QY-5 End
17.11.2022 17.11.2017 01.10.2017 31.12.2017
29.02.2000 28.02.1995 01.01.1995 31.03.1995
01.12.2021 01.12.2016 01.10.2016 31.12.2016
05.05.1992 05.05.1987 01.04.1987 30.06.1987
uj5u.com熱心網友回復：
您可以使用我在GitHub 上的庫中找到的兩個函式：VBA.Date。
? DateThisQuarterUltimo(DateAdd("yyyy", -5, Date))
2017-12-31
? DatePreviousQuarterUltimo(DateAdd("yyyy", -5, Date))
2017-09-30
它們是簡單的高級函式：
' Returns the ultimo date of the quarter of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateThisQuarterUltimo( _
ByVal DateThisQuarter As Date) _
As Date
Dim Interval As String
Dim Number As Double
Dim ResultDate As Date
Number = 0
Interval = IntervalSetting(DtInterval.dtQuarter)
ResultDate = DateIntervalUltimo(Interval, Number, DateThisQuarter)
DateThisQuarterUltimo = ResultDate
End Function
' Returns the ultimo date of the quarter preceding the quarter of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatePreviousQuarterUltimo( _
ByVal DateThisQuarter As Date) _
As Date
Dim Interval As String
Dim Number As Double
Dim ResultDate As Date
Number = -1
Interval = IntervalSetting(DtInterval.dtQuarter)
ResultDate = DateIntervalUltimo(Interval, Number, DateThisQuarter)
DatePreviousQuarterUltimo = ResultDate
End Function
uj5u.com熱心網友回復：
還沒有完全測驗過
您可以使用DateSerial,DateAdd來DatePart實作您想要的...
Option Explicit
Sub Sample()
Dim D As Date
Dim prevD As Date
D = DateSerial(2022, 11, 16)
'~~> Date 5 years years ago
prevD = DateAdd("q", -(4 * 5), D)
'~~> Last date of the quarter for a specific date
Debug.Print DateAdd("q", DatePart("q", prevD), DateSerial(Year(prevD), 1, 1)) - 1
'OUTPUT : 31-12-2017
'~~> Last date of previous quarter for a specific date
Debug.Print DateAdd("q", DatePart("q", D) - 1, DateSerial(Year(D), 1, 1)) - 1
'OUTPUT : 30-09-2022
End Sub
將字串部分更改為正確的日期。
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/535768.html
標籤：擅长VBA