根据单元格值的变化更新 excel 中的动态下拉列表

Question

我正在尝试创建一个表单，希望在用户输入后立即自动更新特定下拉列表的值列表（无需 VBA 代码）。

这是用户将看到的表单：

目前，F 列和 H 列均基于数据验证公式：

INDIRECT("VList!"&SUBSTITUTE(ADDRESS(1,MATCH($B11,VList!:,0),1),"1","")&"2:"&SUBSTITUTE(ADDRESS(1,MATCH($B11,VList!:,0),1),"1","")&COUNTA(INDIRECT("VList!"&ADDRESS(1,MATCH($B11,VList!:,0),4)&":"&ADDRESS(100,MATCH($B11,VList!:),4))))

... 其中 VList 指的是 sheet 如下所示：

所以我的问题是，根据 B 列中的项目名称，是否可以使用值 "Cost Per Unit" [Cell E11] 更新 sheet VList 中的列表，以便下拉列表中的F12 和 H12 自动更新为值 "Cost Per Unit"?

为此研究了很长时间但无济于事，所以我希望在这里寻求一些专家，看看如果没有 VBA，这种情况是否可能发生。谢谢！

编辑： 所以有人告诉我 VBA 代码可以在单元格值发生变化时自动触发，所以我对任何 solutions/help 和 VBA 一样。期间会研究这个方向！

Edit2: 在下面添加了一个简单的插图，希望能更好地描述我在 excel 上想要实现的目标：

*Edit3: 我开始探索 Worksheet_SelectionChange 方法，这是我目前得出的结论：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim projectName As String
    Dim VariableList As Worksheet
    Dim Form As Worksheet

    Dim thisRow As Integer
    Dim correctColumn As Integer
    Dim lastRow As Integer

    Set VariableList = ThisWorkbook.Sheets("VList")
    Set Form = ThisWorkbook.Sheets("Form")

    On Error GoTo EndingSub

    If Target.Column = 5 Then
        thisRow = Target.Row
        projectName = Form.Cells(thisRow, 2)

        correctColumn = Application.Match(projectName, VariableList.Range("1:1"), 0)

        lastRow = VariableList.Columns(correctColumn).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        VariableList.Cells(lastRow + 1, correctColumn).value = Form.Cells(5, thisRow).value

    End If

EndingSub:

End Sub

不知何故，Form.Cells(5, thisRow).Value 的值总是空的。

如果我将它更改为 Target.Value，它仍然采用之前输入的值（例如，我首先将 "ABC" 作为新变量，它不会更新。我更改了新变量到 "DEF"，它用 "ABC" 而不是 "DEF" 更新列表）。它还以某种方式获取 E 列下的所有值。

此外，我在 E11 中放置一个输入后按 Enter 也会导致 E11 和 E12 的值都更新，而只有 E12 已更改。但是，如果我在输入 E11 后单击离开，则只会更新 E11 的值。

我到底做错了什么？

Answer 1

这个我玩的差不多了，如果有大佬能把搞砸的地方改一下，欢迎修改。
我还建议使用 tables。我确实意识到您可以编写冗长的公式来引用范围，但是为您的 table 命名会提供一个带有简单引用的扩展列表。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewVar As Range
On Error GoTo Err
Set NewVar = Range("C:C") 'data entered here, could be a referstorange kind of named range reference
If Application.WorksheetFunction.CountA(Intersect(Target, NewVar)) <> 0 Then Call ertdfgcvb(Target, NewVar) 'only run if there's an intersect, f*ed up but works anyway
Err:
End Sub

Sub ertdfgcvb(Target As Range, NewVar As Range)
Dim ws As Worksheet, Valid As Long, project As String, ListElmnt As String, Unlisted As Boolean, rng1 As Range, rng2 As Range

Set ws = Sheets("VList") 'the data that you refresh
Valid = 2 'projects in column B
HeaderRow = 1 'headers in Vlist are in row #1
uRow = Cells.Rows.Count 'f* yeah, compatibility considerations

For Each Cell In Intersect(Target, NewVar) 'will evaluate for each cell individually, in case you were to insert columns
    ListElmnt = Cell.Value2            'stores the prospective list element
    r = Cell.Row                       'stores the list element's row to...
    project = Cells(r, Valid).Value2   'identify the related project

    HeaderRowRef = HeaderRow & ":" & HeaderRow
    ColumnNum = ws.Range(HeaderRowRef).Find(What:=project, SearchDirection:=xlPrevious, SearchOrder:=xlByColumns, LookAt:=xlWhole).Column   'finds the project in VList
    'MsgBox ws.Name
    Set rng1 = ws.Cells(HeaderRow + 1, ColumnNum)
    Set rng2 = ws.Cells(uRow, ColumnNum)
    LastRow = ws.Range(ws.Cells(HeaderRow + 1, ColumnNum), ws.Cells(uRow, ColumnNum)).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'finds the last row for the project in VList 'f*ed up but works
    Unlisted = True                                                                  'assumes it's unlisted
        For x = HeaderRow + 1 To LastRow
            If ListElmnt = CStr(ws.Cells(x, ColumnNum).Value2) Then Unlisted = False 'unless proven otherwise
        Next
    If Unlisted Then ws.Cells(LastRow + 1, ColumnNum) = ListElmnt                    'if it's unlisted it gets appended to the end of the list
Next
End Sub

编辑：
如何清除 table，示例：

Sub ert()
Dim rng As Range

Set rng = Range("Táblázat1")         'obviously the table name
Do While x < rng.Rows.Count          'for each row
    If rng(x, 1).Value2 = "" Then    'if it's empty
        rng(x, 1).Delete Shift:=xlUp 'then delete but retaining the table format
    Else
        x = x + 1                    'else go to the next line (note: with deletion comes a shift up!)
    End If
Loop

End Sub

根据单元格值的变化更新 excel 中的动态下拉列表

Updating a dynamic dropdown list in excel upon change in cell value

excel

vba

excel-formula