Question

我尝试根据下拉菜单中选择的路线代码填充端口列表。下拉列表在 BASE_RouteCode （'Schedule Tool'!$F$8）范围内，路径代码存储在动态范围 RouteCodes （=Routes!$B$2:INDEX(Routes!$B$2:$B$27, COUNTA(Routes!$B$2:$B$27))）和列表中端口存储在 RoutePorts （=Routes!$B$2:INDEX(Routes!$B$2:$AZ$27, COUNTA(Routes!$B$2:$AZ$27))）中每个路径代码的行中。

目的是让 BASE_RouteCode 的每次更改都触发填充端口列表的子目录;目前，我已经拼凑了这个作为快速尝试。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("BASE_RouteCode")
    Call PopulatePortList
End Sub

Sub PopulatePortList()

Dim iCol As Integer, iRow As Integer
If IsNumeric(WorksheetFunction.Match(Range("BASE_RouteCode").Value, Range("Routecodes"), 0)) Then
    iRow = WorksheetFunction.Match(Range("BASE_RouteCode").Value, Range("Routecodes"), 0) + 1

    ' Testing code
    MsgBox "Row number for route " & Range("BASE_RouteCode").Value & " is " & iRow
    Worksheets("Schedule Tool").Cells(8, 9).Value = iRow

    ' FOR ... WHILE loop (through iCol values) to populate list goes here

Else
    MsgBox "Please select a valid route code."
End If
End Sub

但是，当我更改下拉值时，会有一些短暂的闪烁，但没有任何明显的事情发生，并且代码中没有任何断点被触发。

问号：

我不确定 KeyCells 是否应与目标相同;那从我在其他地方找到的一个例子中复制了，但似乎都没有工作
如果我尝试手动运行 PopulatePortList ，我会得到1004 进入IF子句时出错。

我哪里错了？

Answer 1

我没有完全按照您的问题进行操作，但我认为您只是在用户更改下拉选项时尝试触发例程。

如果是这种情况，那么我认为您不需要工作表更改事件。如果您只使用Forms组合（Developer Ribbon，Controls组，Insert然后在Forms类别中选择组合），您可以右键单击它并为其指定一个宏。当用户更改组合时，将触发此宏。通过右键单击并选择格式控件然后输入输入范围来填充此组合。您还可以指定将使用所选索引（Cell Link）填充的单元格。

Answer 2

请查看以下（调整后的）代码，如果适合您，请告诉我们：

Private Sub Worksheet_Change(ByVal Target As Range)
    'The following line makes sure that this event will only continue if
    '   "BASE_RouteCode" has been changed and not if ANY of the other
    '   cells on this sheet have been changed.
    If Intersect(Target, Range("BASE_RouteCode")) Is Nothing Then Exit Sub
    'Unless there is a global variable called "KeyCells" there is not need
    '   for the following two lines
    'Dim KeyCells As Range
    'Set KeyCells = Range("BASE_RouteCode")

    'The following line makes sure than any changes to the sheet
    '   (while the code is running) will not trigger another
    '   Worksheet change event. Otherwise, this will result in
    '   an endless loop and might crash Excel
    Application.EnableEvents = False
    Call PopulatePortList
    'Enable Events again before exiting. Otherwise this event will not work anymore.
    Application.EnableEvents = True
End Sub

Sub PopulatePortList()

Dim iRow As Long
Dim rngFound As Range

Set rngFound = Worksheets("Routes").Range("Routecodes").Find(Worksheets("Schedule Tool").Range("BASE_RouteCode").Value, , xlValues, xlWhole)
If Not rngFound Is Nothing Then
    iRow = rngFound.Row + 1

    ' Testing code
    MsgBox "Row number for route is " & rngFound.Row & ", " & _
        Chr(10) & "iRow is set to " & iRow & _
        Chr(10) & "and the value of BASE_RouteCode is " & rngFound.Value
    Worksheets("Schedule Tool").Cells(8, 9).Value = iRow

    ' FOR ... WHILE loop (through iCol values) to populate list goes here

Else
    MsgBox "Please select a valid route code."
End If

End Sub

我在代码中添加了一些注释来解释我的更改。如果您需要更多信息，请与我们联系。

根据下拉选择填充列表

2 个答案: