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

Question

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

示例：下拉列表中的引用列表（工作表“列表”）：

A
B
C

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

A

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

Y
B
C

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

A

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

谢谢！

Answer 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

Answer 2

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

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

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")是您所引用的列表。将此粘贴到您的列表表下。

excel下拉菜单，地址为结果

2 个答案:

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