包含公式和可能的自定义输入的单元格

Question

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

举个例子：

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

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

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

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

我已经查看了一些workheet_change，但是我还没弄清楚如何去做。

提前致谢！

Answer 1

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

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

更好： 你有你的下拉列表在任何其他地方，你就像一张桌子一样：

A | 1

B | 2

如果您使用简单的VLOOKUP，那么您可以拥有无​​限多个选项：

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

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

Answer 2

使用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

修改

根据评论我已经更新了我的答案，只有两个案例，使用自定义数字或使用公式返回的值，这假定您的查找公式在A1中，根据需要修改您的代码：< / p>

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的进一步评论后，我更新了代码，以包含公式返回的查找值：

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