根据使用VBA的下拉列表中的选择应用公式

时间:2014-12-08 18:22:37

标签: excel vba formula

我正在尝试开发VBA代码,以便根据我创建的下拉列表中的选择应用特定的公式。

所以我创建了一个带有下拉列表的列表:每年,每两年,每半年和每季度。然后在下一列中完成“最后修订日期”。基于某人从我的列表中选择的内容。我希望“上次修订日期”与我的选择相关联。

例如,如果“上次修订日期”是2014年5月,则下拉列表中的选择是“每年”。我希望下一栏“下次修订日期”自2015年5月起自动填写,因为我选择了Annually。

我将如何处理此代码?

只需将列“A”设为频率(每年,每两年,每半年和每季度)。将列“B”设为最后一个日期。根据“A”列中的选择,将列“C”设为下一个日期。

谢谢!

1 个答案:

答案 0 :(得分:1)

如果您想要将其保留在公式之外并将其存储在代码中,我相信以下内容可以解决您的问题。

Worksheet_Change函数必须与下拉列表相同才能触发宏

如果用户在第二列中没有日期,下面的IsDate函数将确保没有错误。

DateAdd函数有多个输入more info here.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim thisSheet As Worksheet
Set thisSheet = Worksheets("Answer")

Dim nextDateRng As Range
Set nextDateRng = thisSheet.Cells(Target.Row, 3)

Dim dateRng As Range
Set dateRng = thisSheet.Cells(Target.Row, 2)

' makes sure the first column was change
If Not Target.Column <> 1 Then

    ' annually selection moves date 12 months
    If Target.Value = "Annually" And IsDate(dateRng.Value) Then
        monthsToAdd = 12
        nextDateRng.Value = DateAdd("m", monthsToAdd, dateRng.Value)
    End If

    ' bi-annually selection moves date 12 months
    If Target.Value = "Bi-Annually" And IsDate(dateRng.Value) Then
        monthsToAdd = 24
        nextDateRng.Value = DateAdd("m", monthsToAdd, dateRng.Value)
    End If

    ' semi-annually selection moves date 12 months
    If Target.Value = "Semi-Annually" And IsDate(dateRng.Value) Then
        monthsToAdd = 6
        nextDateRng.Value = DateAdd("m", monthsToAdd, dateRng.Value)
    End If

    ' quarterly selection moves date 12 months
    If Target.Value = "Quarterly" And IsDate(dateRng.Value) Then
        monthsToAdd = 3
        nextDateRng.Value = DateAdd("m", monthsToAdd, dateRng.Value)
    End If

End If

End Sub