Question

我已经写了下面的宏，我知道，这可能效率很低，但我是一个新手，对VBA缺乏经验！

此值在任何时候调用＆＃34;是＆＃34;输入/写入的值将始终显示在单元格F2和G2中。

我试图改变这一点，例如，如果E12 =＆＃34;是＆＃34;并在消息框中输入日期，该日期和计算的天数将分别显示在F12和G12中。此电子表格的每一行都是针对其他人的计算。

非常感谢任何帮助。谢谢！

Sub GetStartDate()
Dim QtyEntry As Date
Dim Msg As String
Dim n As Integer
If ActiveCell.Value = "Yes" Then
Const MinDate As Date = #11/1/2017#
Const MaxDate As Date = #10/31/2018#
Msg = "Enter effective date in role and/or level in MM/DD/YYYY format for the 2017-2018 Performance Year"
Do
    QtyEntry = InputBox(Msg)
        If IsDate(QtyEntry) Then
        If QtyEntry >= MinDate And QtyEntry <= MaxDate Then Exit Do
        End If
        Msg = "Please enter valid date range within the Performance Year."
        Msg = Msg & vbNewLine
        Msg = Msg & "Please enter a date between " & MinDate & " and " & MaxDate
        Loop
n = DateDiff("d", QtyEntry, MaxDate)
Cells(2, 7) = n
ActiveSheet.Range("F2").Value = QtyEntry
Exit Sub
Else
    Cells(2, 7) = "365"
End If
End Sub

Answer 1

这可能就像将硬编码的2更改为ActiveCell.Row一样简单：

Sub GetStartDate()
Dim QtyEntry As Date
Dim Msg As String
Dim n As Integer
If ActiveCell.Value = "Yes" Then
Const MinDate As Date = #11/1/2017#
Const MaxDate As Date = #10/31/2018#
Msg = "Enter effective date in role and/or level in MM/DD/YYYY format for the 2017-2018 Performance Year"
Do
    QtyEntry = InputBox(Msg)
        If IsDate(QtyEntry) Then
        If QtyEntry >= MinDate And QtyEntry <= MaxDate Then Exit Do
        End If
        Msg = "Please enter valid date range within the Performance Year."
        Msg = Msg & vbNewLine
        Msg = Msg & "Please enter a date between " & MinDate & " and " & MaxDate
        Loop
n = DateDiff("d", QtyEntry, MaxDate)
Cells(ActiveCell.Row, 7) = n
ActiveSheet.Range("F" & ActiveCell.Row).Value = QtyEntry
Exit Sub
Else
    Cells(ActiveCell.Row, 7) = "365"
End If
End Sub

Excel VBA将结果放在相邻单元格中

1 个答案: