excel下拉菜单,地址为结果

时间:2019-03-21 06:34:52

标签: excel excel-formula

Excel中的常规数据验证下拉列表会将所选的放入单元格中。但就我而言,我引用的是工作表中的另一个列表,其元素可以更改。我的目标是使这些更改适用于已选择的下拉菜单项。

示例: 下拉列表中的引用列表(工作表“列表”):

  • A
  • B
  • C

用户从“选择”工作表的下拉列表中选择A:

  • A

现在,用户将工作表“列表”中的A更改为Y:

  • Y
  • B
  • C

“选择”工作表中的用户选择仍然显示A,但现在应显示Y:

  • A

这有可能吗?我可以吗使下拉结果指向值的地址,而不是值本身?

谢谢!

2 个答案:

答案 0 :(得分:1)

下降专长。工作表更改事件

  • 要“复制”设置,请在工作表List中创建一个名称 Drop1引用包含值的列范围。然后 我在工作表的B2中创建了一个验证下拉列表 Selection,然后选择名称(Drop1)作为列表。
  • 更改常数(Const)以适合您的需求。

Module1

Option Explicit

Public strListSheet As String
Public strListRange As String
Public vntList As Variant

Sub Drop(rngList As Range)

    Const cDropSheet As String = "Selection"
    Const cDropRange As String = "B2"

    Dim rng As Range
    Dim vntNew As Variant
    Dim vntVal As Variant
    Dim Nor As Long
    Dim i As Long

    Set rng = ThisWorkbook.Worksheets(cDropSheet).Range(cDropRange)
    vntVal = rng
    vntNew = rngList
    Nor = UBound(vntList)

    For i = 1 To Nor
        If vntList(i, 1) = vntVal Then
            If vntVal <> vntNew(i, 1) Then
                rng = vntNew(i, 1)
            End If
            Exit For
        End If
    Next

    vntList = vntNew

End Sub

Sub Initialize()

    Const strDrop as string = "Drop1"

    Dim str1 As String
    Dim lngInStr As Long

    ' Prepare
    str1 = Names(strDrop).RefersTo
    lngInStr = InStr(1, str1, "!")

    ' Write Public Variables
    strListRange = Right(str1, Len(str1) - lngInStr)
    strListSheet = WorksheetFunction.Substitute(WorksheetFunction _
            .Substitute(Left(str1, lngInStr - 1), "=", ""), "'", "")
    vntList = Worksheets(strListSheet).Range(strListRange)

End Sub

此工作簿

Option Explicit

Private Sub Workbook_Open()
    Initialize
End Sub

列表(工作表)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo ErrInit
    If Target.Cells.Count = 1 Then
        Dim rngList As Range
        Set rngList = ThisWorkbook.Worksheets(strListSheet) _
                .Range(strListRange)
        If Not Intersect(Target, rngList) Is Nothing Then
            Drop rngList
        End If
    End If
Exit Sub

ErrInit:
    MsgBox "An unexpected error occurred. Error '" & Err.Number & "':" _
            & Err.Description, vbCritical, "Error"
    On Error GoTo 0
    Initialize

End Sub

答案 1 :(得分:1)

不幸的是,没有任何方法可以使用公式或内置函数(据我所知)

这是您可以应用并使用的简单方法:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target(1, 1), Range("A1:A3")) Is Nothing Then
        ActiveWorkbook.Sheets("Selection").Range("A1").Value = Target(1, 1)
    End If
End Sub

假设Range("A1:A3")是您所引用的列表。将此粘贴到您的列表表下。