Question

所以，现在我有这个Excel工作表，其中有最后修订日期。我已将此列命名为＃34; LastRevisionDate＆＃34;。然后我有一个名为＆＃34; RevisionFrequency＆＃34; 。＆＃34; RevisionFrequency＆＃34;包含一个由术语Annually，Semi-Annually和Quarterly组成的下拉菜单（数据验证）。然后我有一个列，其中列出了＆＃34; NextRevisionDate＆＃34;。

所以我想编写一些VBA代码来计算 LastRevisionDate 和 RevisionFrequency 中的 NextRevisionDate 。

例如。在专栏＃34; A＆＃34;我将RevisionFrequency设为Semi-Annually，最后修订日期为{＆＃34}栏中的Mar-14，然后我希望列中的 NextRevisionDate ＃34; C＆＃34;陈述九月。这基本上说该项目每年修订两次。

所以我想创建一个宏，其中Column＆＃34; C＆＃34;基于 RevisionFrequency 和 LastRevisionDate 。我意识到我可以用公式做到这一点，但我不断添加新项目，所以我不想继续将公式复制到每个单元格中。对于某些项目，它们也不需要修改，如果没有 LastRevisionDate ，我还希望有一个空白单元格。

到目前为止，我有这段代码：

Private Sub Worksheet_Change(ByVal Target As Range)


Dim ws As Worksheet
 Set ws = Sheets(1)
'For this reference of the Column Named LastCalDate I am getting an error 
If Not Intersect(Target, ws.Range("LastCalDate").Value) Is Nothing Then

Dim Lastdate As Date
 Dim DueDate As Variant
 Dim Frequency As String
 Dim R As Variant
 Dim C As Variant
 Dim R1 As Variant
 Dim C1 As Variant
 Dim R2 As Variant
 Dim C2 As Variant




R = Range("LastCalDate").Row
 C = Range("LastCalDate").Column

R1 = Range("CalDueDate").Row
 C1 = Range("CalDueDate").Column

R2 = Range("CalFrequency").Row
 C2 = Range("CalFrequency").Column

Lastdate = Cells(R, C).Value 'Last Cal Date
 DueDate = Cells(R1, C1).Value 'Cal Due Date
 Frequency = Cells(R2, C2)

If Frequency = "Annually" Then

DueDate = DateAdd("mmm", 12, Lastdate)

End If

If Frequency = "Semi-Annually" Then
 DueDate = DateAdd("mmm", 6, Lastdate)
 End If

If Frequency = "Quarterly" Then
 DueDate = DateAdd("mmm", 3, Lastdate)
 End If



End Sub

这是我到目前为止所拥有的。我不确定我是否正确地这样做了？

Answer 1

使用Worksheet_Change方法是创建新单元格值的好方法，无需复制和粘贴公式。我还在我的代码中包含了检查，以确保未设置日期或频率，然后清除该值。

Private Sub Worksheet_Change(ByVal Target As Range)

' declare and set worksheet
Dim ws As Worksheet
Set ws = Sheets(1)

' declare and set default date
Dim DefaultDueDate As Date

' declare needed variables
Dim StartDate As Date
Dim Frequency As String
Dim DueDate As Date

' make sure the change only occured on the "A" or "B" column
If Target.Column = 1 Or Target.Column = 2 Then

    StartDate = ws.Range("A" & Target.Row)
    Frequency = ws.Range("B" & Target.Row)

    ' if start date does not equal the default due date and the frequency is not blank, set due date variable
    If StartDate <> DefaultDueDate And Frequency <> "" Then

        ' add months to the provided start date
        If Frequency = "Annually" Then
            DueDate = DateAdd("m", 12, StartDate)
        ElseIf Frequency = "Semi-Annually" Then
            DueDate = DateAdd("m", 6, StartDate)
        ElseIf Frequency = "Quarterly" Then
            DueDate = DateAdd("m", 3, StartDate)
        End If

        ' Make sure frequency selection is correct and due date was set
        If DueDate <> DefaultDueDate Then
            ws.Range("C" & Target.Row) = DueDate
        End If

    Else

        ' clear Next Revision Date when Frequency or Start Date is blank
        ws.Range("C" & Target.Row) = ""

    End If

End If

End Sub

使用VBA基于频率计算到期日期

1 个答案: