Question

我想创建多个从属下拉列表（3个从属下拉列表）。我可以使用公式=INDIRECT()使用数据验证进行创建，但是我只能将其应用于一个单元格，而不想将其应用于范围或整个列。我想使用Macro（Vba代码）来实现这种情况。假设第一个下拉列表包含国家/地区，第二个从属下拉列表包含州，第三个从属下拉列表包含城市，并且Cities下拉列表应与”，“ 分隔。我可以使用数据列表和公式实现此功能，但是我想使用VBA代码创建它。我想在代码本身中提供下拉列表，并将每个依赖下拉列表应用于range（column）。

Answer 1

请尝试下一种方法：

将下一个代码复制到标准模块中。它将创建（在单元格“ G1”中）第一个验证（州/国家/地区）：

Sub CreateValidationTest()
 Dim sh As Worksheet, rng As Range, strMerge As String, statesList As String
 Dim lastColLet As String
 
 Set sh = ActiveSheet 'use here your sheet to be processed
 Set rng = sh.Range("G1") 'use here the range where you need to create the Validation
 
 If Range("A1").MergeCells Then 'check if "A1" is part of a merged cells area
    strMerge = Range("A1").MergeArea.Address
 Else
    MsgBox "No merge cells starting with ""A1""!": Exit Sub
 End If
 
 'create states list:_________________________________________________________________
  lastColLet = Split(strMerge, "$")(3)
  statesList = Join(Application.Index(Range("A2:" & lastColLet & 2).Value, 1, 0), ",")
  '___________________________________________________________________________________
  
 With rng.Validation 'create Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                   Operator:=xlBetween, Formula1:=statesList
    .IgnoreBlank = True
    .InCellDropdown = True
    .ShowInput = True
    .ShowError = True
 End With
End Sub

将以下事件复制到要处理的数据所在的工作表模块中（右键单击工作表名称->查看代码）：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim rngDV As Range, oldVal As String, newVal As String
 Dim arr As Variant, El As Variant

 If Target.count > 1 Then GoTo exitHandler
 If Target.Address(0, 0) = "G1" Then
    'create the second validation
    Dim stCell As Range, lastRow As Long, listValid As String
    Set stCell = rows(2).Find(what:=Target.Value, LookIn:=xlValues, Lookat:=xlWhole)
    If stCell Is Nothing Then Exit Sub
    lastRow = cells(rows.count, stCell.Column).End(xlUp).row
    'Debug.Print Range(stCell.Offset(1), cells(lastRow, stCell.Column)).Address: Stop
    listValid = Join(Application.Transpose(Application.Index(Range(stCell.Offset(1), cells(lastRow, stCell.Column)).Value, 0, 1)), ",")
    
    Application.EnableEvents = False
    With Range("H1").Validation 'create the second Validation for Cities
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                       Operator:=xlBetween, Formula1:=listValid
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    Range("H1").Value = ""
 ElseIf Target.Address(0, 0) = "H1" Then
    Application.EnableEvents = False
    newVal = Target.Value: Application.Undo
    oldVal = Target.Value: Target.Value = newVal
    If oldVal <> "" Then
      If newVal <> "" Then
         arr = Split(oldVal, ",")
         For Each El In arr
            If El = newVal Then
                Target.Value = oldVal
                GoTo exitHandler
            End If
         Next
         Target.Value = oldVal & "," & newVal
         Target.EntireColumn.AutoFit
      End If
    End If
 End If

exitHandler:
  Application.EnableEvents = True
End Sub

使用方法：

a。首先，您必须运行CreateValidationTest Sub，然后使用其验证列表。

b。您必须知道，第一个验证将在“ G1”中创建，第二个验证将在“ H1”中创建。该代码不允许选择已经存在的项目（在用逗号分隔的字符串中）。

多选下拉菜单

1 个答案: