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

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim dvCell As Range
    Dim inputRange As Range
    Dim c As Range
    
    ' 设置下拉菜单的范围
    Set rng = Range("A1:A10")
    
    ' 设置下拉菜单的单元格
    Set dvCell = Range("B1")
    
    ' 检查是否更改了下拉菜单的单元格
    If Not Application.Intersect(Target, dvCell) Is Nothing Then
        Application.EnableEvents = False
        dvCell.ClearContents
        
        ' 根据选择的值设置下拉菜单的选项
        For Each c In rng
            If c.Value = Target.Value Then
                If inputRange Is Nothing Then
                    Set inputRange = c.Offset(0, 1)
                Else
                    Set inputRange = Union(inputRange, c.Offset(0, 1))
                End If
            End If
        Next c
        
        ' 将选项设置为下拉菜单的数据验证
        With dvCell.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=Join(Application.Transpose(inputRange), ",")
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        
        Application.EnableEvents = True
    End If
End Sub