[ad_1]
Tôi đã viết một mã tạo danh sách thả xuống động mà không có khoảng trống
và nó hoạt động rất tốt, nhưng vấn đề duy nhất là khi tôi chạy marco trong khi tôi đang nhấp vào bất kỳ đối tượng nào (hình ảnh, nút, v.v.), nó hiển thị Lỗi thời gian chạy ‘1004’ Lỗi do ứng dụng xác định hoặc do đối tượng xác định
Tôi đã sử dụng trình gỡ lỗi trong VBA và nó hiển thị lỗi ở hai lỗi này
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=Join(Application.Transpose(valuesArray), ",")
Và đây là toàn bộ code, mong các bạn giúp đỡ
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
Những gì tôi đã thử:
Tôi đã thử mọi cách tôi biết nhưng không có gì hiệu quả
Giải pháp 1
Hãy thử chia dòng này:
VBA
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=Join(Application.Transpose(valuesArray), ",")
vào trong:
VBA
Dim result As String result = Join(Application.Transpose(valuesArray), ",") .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=result
[ad_2]
コメント