在更改单元格值时更新Excel中的dynamic下拉列表

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

这里是用户将看到的forms：

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

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"值？

经过长时间的研究没有用，所以我希望能find一些专家来看看这样的情况，甚至没有VBA。 谢谢！

编辑：所以我被告知VBA代码可以在单元格值发生变化时自动触发，所以我也可以使用VBA的任何解决scheme/帮助。 同时将在这个方向上研究！

编辑2：在下面添加了一个简单的例子，希望更好地描述我想在Excel中实现什么：

*编辑3：我开始探索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它仍然采用之前input的值（例如，我首先将“ABC”作为新variables，但不会更新。我将新variables更改为“DEF”，它将更新列表与“ABC”而不是“DEF”）。 它也采取列E下的所有值。

另外，在E11中input一个input之后，按下回车键也会导致只有E12被更改时，E11和E12的值才会更新。 但是，如果我在E11input后点击，则只有E11的值被更新。

我在这里做错了什么？

Answer 1

我几乎对这个有兴趣，如果任何人都可以提炼拧紧部分随意修改。
我还build议使用表格。 我意识到你可以编写冗长的公式来引用范围，但给你的表名称给出了一个简单的参考扩展名单。

 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