使用命名范围通过 vba 创建 excel 数据验证

Question

我有以下代码：

Function createCascadingDropDown(sourceTable As ListObject, targetTable As ListObject, targetTableCorespondingColumn As Integer, targetWs As Worksheet, targetWsDropDownColumn As Integer)
    Dim currentDropDownList As String, dropDownName As String, formula As String
    Dim validationVariable As Validation
    currentDropDownListName = targetWs.Name & "CurrentDropDownList"
    dropDownName = targetWs.Name & "DropDown"
    targetWs.Names.Add Name:=currentDropDownListName, RefersToLocal:="=INDEX(" & targetWs.Name & "!" & currentDropDownListName & ";1;1):INDEX(" & targetWs.Name & "!" & currentDropDownListName & ";COUNTA(" & targetWs.Name & "!" & currentDropDownListName & "))"
    targetWs.Names.Add Name:=dropDownName, RefersToLocal:="=INDEX(" & sourceTable.Name & ";0;MATCH(INDEX(" & targetTable.Name & "[@];" & CStr(targetTableCorespondingColumn) & ");" & sourceTable.Name & "[#Headers];0))"
    formula = "=" & dropDownName
    With targetWs.columns(targetWsDropDownColumn).EntireColumn.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=formula
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .InputMessage = ""
        .ErrorTitle = ""
        .ErrorMessage = ""
        .ShowInput = False
        .ShowError = True
    End With
    targetWs.Cells(1, targetWsColumn).Validation.Delete
End Function

总的来说，我正在尝试以编程方式构建级联下拉菜单，如 https://www.contextures.com/exceldatavaldependindextables.html。

问题出现在我添加验证的那一行。这里出现错误"Application-defined or object-defined error"。

当我添加断点并手动执行此步骤时，尽管 excel 告诉我 "The source currently evaluates to an error. Do you want to continue?"，但它仍然有效。这可能就是问题所在；至少我找到了 this and this，这两者都没有帮助。在公式周围环绕 IFERROR 使其无效。

所以我也尝试将 RefereToLocal 设置为一个空单元格（例如“=$A$20”），然后再更改它。现在的问题是，它不再接受 完全相同的 公式：

targetWs.Names.Item(dropDownName).RefersToLocal ="=INDEX(" & targetWs.Name & "!" & currentDropDownListName & ";1;1):INDEX(" & targetWs.Name & "!" & currentDropDownListName & ";COUNTA(" & targetWs.Name & "!" & currentDropDownListName & "))"

我真的运行没主意了。如果您也有任何解决原始问题的方法（使用 vba 实现 vba-free 级联下拉菜单），我很乐意为您解答！

Answer 1

由于到目前为止这里还没有人有想法，我想这个问题很难解决或无法解决。如果其他人想以编程方式创建级联下拉菜单，这里有一个解决方法，无需 tables，因为我认为 tables 是问题所在。顺便说一句，可以将工作表格式设置为 table afterwards:

Function createCascadingDropDown(sourceWs As Worksheet, targetWs As Worksheet, targetCorespondingColumn As Integer, targetDropDownColumn As Integer, sourceNumberOfRowsPerColumnAs Object)
    Dim numberOfColumns As Integer, numberOfRows As Integer, targetLastRow As Long
    Dim targetCorespondingColumnSecondRowRange As String, valDataName As String, counterName As String, useListeName As String
    valDataName = "ValData" & sourceWs.Name
    counterName = "Counter" & sourceWs.Name
    useListeName = "UseListe" & sourceWs.Name
    targetLastRow = targetWs.Rows.CountLarge
    numberOfCulumns = sourceNumberOfRowsPerColumn.Count
    'Get the maximum number of rows in the source worksheet
    numberOfRows = 0
    For Each columnKey In sourceNumberOfRowsPerColumn.Keys
        If sourceNumberOfRowsPerColumn(columnKey) > numberOfRows Then
            numberOfRows = sourceNumberOfRowsPerColumn(columnKey)
        End If
    Next columnKey
    targetCorespondingColumnSecondRowRange = targetWs.Cells(1, targetCorespondingColumn).Address(RowAbsolute:=False, ColumnAbsolute:=True)
    targetWs.Names.Add Name:=counterName, RefersTo:="=COUNTA(INDEX(" & valDataName & ",,MATCH(" & targetWs.Name & "!" & targetCorespondingColumnSecondRowRange & "," & sourceWs.Name & "!:,0)))"
    targetWs.Names.Add Name:=useListeName, RefersTo:="=INDEX(" & valDataName & ",1,MATCH(" & targetWs.Name & "!" & targetCorespondingColumnSecondRowRange & "," & sourceWs.Name & "!:,0)):INDEX(" & valDataName & "," & counterName & ",MATCH(" & targetWs.Name & "!" & targetCorespondingColumnSecondRowRange & "," & sourceWs.Name & "!:,0))"
    With targetWs.Range(targetWs.Cells(2, targetDropDownColumn), targetWs.Cells(targetLastRow, targetDropDownColumn)).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & useListeName
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .InputMessage = ""
        .ErrorTitle = ""
        .ErrorMessage = ""
        .ShowInput = False
        .ShowError = True
    End With
End Function

其中 sourceNumberOfRowsPerColumn 必须是字典，并且 Master 列在列 targetCorespondingColumn 的其他位置创建。此外，此解决方案仅允许一个级联步骤，并且 Master 列的源位于不同的工作表中。

作为此解决方案的基础，我采用了 https://www.contextures.com/xlDataVal15.html 中的示例。

使用命名范围通过 vba 创建 excel 数据验证

Create excel data validation with vba using named ranges

validation

excel

vba

cascadingdropdown

named-ranges