更改单元格值后在excel中更新动态下拉列表

Question

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

这是用户将看到的表格：

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

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

...其中VList是指工作表，如下所示：

所以我的问题是，根据列B中的项目名称，有没有一种方法可以用值"Cost Per Unit" [Cell E11]更新VList表中的列表，以便F12和H12中的下拉列表自动获得更新为"Cost Per Unit"值吗？

对此进行了很长时间的研究都没有结果，所以我希望在这里寻求一些专家，看看在没有VBA的情况下这种情况是否可能实现。 谢谢！

编辑：所以有人告诉我，可以在单元格值发生更改时自动触发VBA代码，因此我也对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列下的所有值。

此外，在仅将E12更改后，在我将一个输入放在E11中之后按Enter键也将更新E11和E12的值。 但是，如果在输入E11之后单击鼠标左键，则仅更新E11的值。

我到底在做什么错？

Answer 1

如果有人可以完善这个拧紧的零件，我可以随时进行修改，这几乎让我很开心。
我还建议使用表格。 我确实知道您可以编写冗长的公式来引用范围，但是为表命名可以提供带有简单引用的扩展列表。

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

编辑：
如何清除表，例如：

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