使用命名范围使用 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。

问题出现在我添加验证的行中。这里出现错误“应用程序定义或对象定义错误”。

当我添加断点并手动执行此步骤时，它可以工作，尽管事实上，excel 告诉我“源当前评估为错误。你想继续吗？”。这可能是问题所在；至少我找到了this 和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 的级联下拉菜单），我很乐意为您解答！

Answer 1

由于到目前为止这里没有人有任何想法，我猜这个问题很难解决或无法解决。如果其他人想以编程方式创建级联下拉菜单，这里有一个解决方法，它可以在没有表格的情况下工作，因为我认为表格是问题所在。顺便说一下，之后可以将工作表格式化为表格：

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 & "!$1:$1,0)))"
    targetWs.Names.Add Name:=useListeName, RefersTo:="=INDEX(" & valDataName & ",1,MATCH(" & targetWs.Name & "!" & targetCorespondingColumnSecondRowRange & "," & sourceWs.Name & "!$1:$1,0)):INDEX(" & valDataName & "," & counterName & ",MATCH(" & targetWs.Name & "!" & targetCorespondingColumnSecondRowRange & "," & sourceWs.Name & "!$1:$1,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 为例。