VBA excel 中运行时错误“1004”应用程序定义或对象定义错误

编程


我编写了一段代码,创建没有任何空白的动态下拉列表
它工作得很好,但唯一的问题是当我在单击任何对象(图片、按钮等)时运行 marco 时,它显示运行时错误“1004”应用程序定义或对象定义错误

我在VBA中使用了调试器,它显示了这两个错误

VB
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
             xlBetween, Formula1:=Join(Application.Transpose(valuesArray), ",")

这是完整的代码,请帮忙

VB
Sub DynamicDropDown()
    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet
    Dim sourceRange As Range
    Dim destinationRange As Range
    Dim cell As Range
    Dim validationFormula As String
    Dim nonBlankValues As Collection
    Dim dropDownCell As Range
    
    ' Set source and destination sheets
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set destinationSheet = ThisWorkbook.Sheets("Sheet2")
    
    ' Define the source range (adjust the range as needed)
    Set sourceRange = sourceSheet.Range("A1:A" & sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row)
    
    ' Define the destination range where you want the drop-down list
    Set destinationRange = destinationSheet.Range("N10")
    
    ' Create a collection to store non-blank values
    Set nonBlankValues = New Collection
    
    ' Collect non-blank values from the source range
    On Error Resume Next
    For Each cell In sourceRange
        If cell.Value <> "" Then
            nonBlankValues.Add cell.Value, CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0
    
    ' Convert the collection to an array
    Dim valuesArray() As Variant
    ReDim valuesArray(1 To nonBlankValues.Count, 1 To 1)
    
    Dim i As Integer
    For i = 1 To nonBlankValues.Count
        valuesArray(i, 1) = nonBlankValues(i)
    Next i
    
    ' Set the validation formula
    destinationRange.Validation.Delete
    With destinationRange.Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
             xlBetween, Formula1:=Join(Application.Transpose(valuesArray), ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
  
End Sub

我尝试过的:

我已经尝试了我所知道的一切,但没有任何效果

解决方案1

尝试分割这一行:

编程语言
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
     xlBetween, Formula1:=Join(Application.Transpose(valuesArray), ",")

进入:

编程语言
Dim result As String
result  = Join(Application.Transpose(valuesArray), ",")
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
     xlBetween, Formula1:=result 

コメント

タイトルとURLをコピーしました