Question

我对Excel中的VBA全新，尽可能快地尽可能多地学习，这样可以帮助我完成硕士论文。

我有一个相当大的数据集，包含每日股票回报。我想将每个月的最后一天复制到一张新表中，但我仍然坚持这样做。

目前我正在使用代码根据不同工作表中的A列生成一列日期。我在下面提供了这个代码，但它实际上并没有过滤，只是生成下个月的第一天和第十五天。

Private Sub Listmonths(strWksResult As String, strWksData As String)

Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date

FirstDate = Worksheets(strWksData).Range("A21").Value
LastDate = Worksheets(strWksData).Range("A4696").Value

NextDate = FirstDate
Worksheets(strWksResult).Range("A2").Select
'selection of columns within one row
Do Until NextDate >= LastDate

ActiveCell.Value = NextDate
ActiveCell.Offset(1, 0).Select

If Day(NextDate) = 1 Then
    NextDate = DateAdd("d", NextDate, 14)
Else
    NextDate = DateAdd("d", NextDate, 20)
    NextDate = DateSerial(Year(NextDate), Month(NextDate), 1)
End If

Loop


End Sub

非常感谢任何帮助！

提前致谢

Answer 1

每个月的最后一天是下个月第一天的前一天。通过这种方式，可以轻松编写VBA代码或Excel公式。

如果原始日期是d，那么

DateSerial(Year(d), Month(d) + 1, 1) - 1

是包含d。

的月份的最后一天

<强>更新

我不知道问题的哪一部分对你很明显。这是代码的完整版本（它发现从头开始构建它更好）：

Option Explicit

Private Sub Listmonths(strWksResult As String, strWksData As String)
    Dim rngResult As Range: Set rngResult = Worksheets(strWksResult).Range("A1")
    Dim rngDates As Range: Set rngDates = Worksheets(strWksData).Range("A21:A4696") ' This should be changed to a Named Range or calculation based on UsedRange
    Dim rr As Long: rr = 1
    Dim r As Long: For r = 1 To rngDates.Rows.Count
        Dim varDate As Variant: varDate = rngDates.Cells(r, 1).Value ' In case of performance problems read the whole range at once
        If IsDate(varDate) Then
            If varDate = DateSerial(Year(varDate), Month(varDate) + 1, 1) - 1 Then
                rngResult.Cells(rr, 1).Value = varDate
                rngResult.Cells(rr, 2).Value = rngDates.Cells(r, 2).Value ' In case of performance problems write the whole range at once
                rr = rr + 1
            End If
        End If
    Next r
End Sub

Answer 2

替换这些行：

If Day(NextDate) = 1 Then
    NextDate = DateAdd("d", NextDate, 14)
Else
    NextDate = DateAdd("d", NextDate, 20)
    NextDate = DateSerial(Year(NextDate), Month(NextDate), 1)
End If

与

Select Case Day(NextDate)
Case 1
    NextDate = NextDate + 14
Case 15
    NextDate = DateSerial(Year(NextDate), Month(NextDate) + 1, 1) - 1
Case Else
    NextDate = DateSerial(Year(NextDate), Month(NextDate) + 1, 1)
End Select

获得（1）每月的第一天，（2）每月的第15天，以及（3）每个月的最后一天。

如果您只是在寻找每个月的最后一天，那么您应该只使用

NextDate = DateSerial(Year(NextDate), Month(NextDate) + 2, 1) - 1

VBA：查找月份的最后几天并复制到另一张表格

2 个答案: