在单元格值更改时更新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列中的项目名称，有没有办法更新工作表VList中的值为"Cost Per Unit" [Cell E11]的列表，以便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，它仍然需要输入的前一个值（例如，我首先输入＆＃34; ABC＆＃34;作为新变量，它不会更新。我将New Variable更改为＆＃34; DEF＆＃34;，它使用＆＃34; ABC＆＃34;而不是＆＃34; DEF＆＃34;）更新列表。它还会以某种方式获取E列下的所有值。

此外，在E11中输入一个输入后按Enter键也会在仅更改E12时更新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