使用命名范圍使用 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 中的示例為例。