问如何在Excel中使用VBA制作基于单元格值的条件下拉菜单

EN

Sub Main()
    With Worksheets("sheetWithDropDownName").Range("A1").Validation '<--| change "sheetWithDropDownName" and "A1" to your actual "dropdown" worksheet and cell references
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(GetTitles(), ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Function GetTitles() As Variant
    Dim cell As Range, rng As Range

    With Worksheets("sheetWithDataName") '<--| change "sheetWithDataName" to your actual sheet with data name
        Set rng = .Range("A1", .cells(.Rows.Count, "E").End(xlUp))  '<--| set a range as its columns A:E range from row 1 down to last column E not empty row
    End With
    With CreateObject("Scripting.Dictionary")
        For Each cell In rng.Columns(5).cells
            If cell.Value = "index" Then .Item(cell.Offset(, -4).Value) = cell.Offset(, -4).Value
        Next cell
        GetTitles = .keys
    End With
End Function

Private Sub UserForm_Initialize()
Dim lLastRow As Long
Dim i As Integer

lLastRow = Worksheets("MyData").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To lLastRow
        If Worksheets("MyData").Cells(i, 5) = "index" Then
            ComboBox1.AddItem (Worksheets("MyData").Cells(i, 1))
        End If
    Next

End Sub