带有公式和可能的自定义输入的单元格

Question

我有一个带有基于另一个单元格的公式的单元格。这个另一个单元格是一个数据验证单元格，用户可以在下拉列表中选择各种选项。

举个例子：

如果用户在下拉列表中选择“A”，则公式计算“1+1”。

如果用户在下拉列表中选择“B”，则公式计算“1+2”。

下拉列表中的最后一个选项是“自定义”。如果选择此选项，则用户应插入自定义数字。

但是，如果用户返回并在下拉菜单中选择“A”，则应保留公式并计算“1+1”。

我已经查看了一些 worksheet_change，但我无法弄清楚如何去做。

提前致谢！

Answer 1

使用 Worksheet_Change 事件，您可以执行以下操作，这假设您的数据验证列表位于单元格 B1 中，并且您希望结果位于 C1 中：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
Dim CustomNumber As Variant
If Target.Address = "$B$1" Then
    Select Case ws.Range("B1").Value
        Case "A"
            ws.Range("C1").Formula = "=1+1"
        Case "B"
            ws.Range("C1").Formual = "=1+2"
        Case "C"
            ws.Range("C1").Formula = "=1+3"
        Case "D"
            ws.Range("C1").Formula = "=1+4"
        Case "E"
            ws.Range("C1").Formula = "=1+5"
        Case "Custom"
            CustomNumber = InputBox("Please enter a custom number", "Custom")
            If IsNumeric(CustomNumber) Then
                ws.Range("C1").Formula = "=1+" & CustomNumber
            Else
                MsgBox "Please enter a number", vbCritical = vbOKOnly
                Exit Sub
            End If
    End Select
End If
End Sub

编辑：

根据 cmets，我已将答案更新为只有两个案例，使用自定义数字或使用公式返回的值，这假设您的查找公式在 A1 中，根据需要修改您的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
Dim CustomNumber As Variant
If Target.Address = "$B$1" Then
    Select Case ws.Range("B1").Value
        Case "Custom"
            CustomNumber = InputBox("Please enter a custom number", "Custom")
            If IsNumeric(CustomNumber) Then
                ws.Range("C1").Formula = "=1+" & CustomNumber
            Else
                MsgBox "Please enter a number", vbCritical = vbOKOnly
                Exit Sub
            End If
        Case Else 'if your lookup formula is in A1, then the code below will add one to the value from the formula
            ws.Range("C1").Formula = "=1+" & Val(ws.Range("A1").Value)
    End Select
End If
End Sub

更新：

在 OP 的进一步 cmets 之后，我更新了代码以包含公式返回的查找值：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
Dim CustomNumber As Variant
If Target.Address = "$B$1" Then
    Select Case ws.Range("B1").Value
        Case "Custom"
            CustomNumber = InputBox("Please enter a custom number", "Custom")
            If IsNumeric(CustomNumber) Then
                ws.Range("C1").Formula = "=1+" & CustomNumber
            Else
                MsgBox "Please enter a number", vbCritical = vbOKOnly
                Exit Sub
            End If
        Case Else 'if your lookup formula is in A1, then the code below will add one to the value returned by the LookUp
            LookUpValue = "Ground type"
            LookUpTable = "Ground_type_table[#Alle]"
            ValueReturned = Application.WorksheetFunction.VLookup(LookUpValue, LookUpTable, 4, False)
            ws.Range("C1").Formula = "=1+" & Val(ValueReturned)
    End Select
End If
End Sub

Answer 2

如果允许硬编码您的答案而不是我建议的（不带 VBA）：

=IF(A1="A";1;IF(A1="B";2;A1))+1

更好： 您在任何其他地方都有您的下拉列表，并且您可以像表格一样完成它：

一个 | 1

B | 2

如果您使用简单的 VLOOKUP，则可以有无限多的选项，例如：

=IFERROR(VLOOKUP(A1;A2:B3;2;WRONG);A1)+1

这可能在单元格 B2 中。 但是在这种情况下，您的行为可能会有所不同。