Excel 获取运行时错误1004-方法';添加';对象的';验证';失败

Excel 获取运行时错误1004-方法';添加';对象的';验证';失败,excel,vba,Excel,Vba,我正在尝试通过excel工作表上的vba添加数据验证列表。但每隔几次我尝试运行这段代码时,就会出现运行时错误1004-对象“验证”的方法“添加”失败。下面是完整的代码 Option Explicit Sub rwins() Dim w As Workbook Dim ws As Worksheet Dim ButtonText As String Dim fr1 As Long Dim lr1 As Long Dim i As Long Dim wss As Worksheet Dim cl A

我正在尝试通过excel工作表上的vba添加数据验证列表。但每隔几次我尝试运行这段代码时,就会出现运行时错误1004-对象“验证”的方法“添加”失败。下面是完整的代码

Option Explicit
Sub rwins()
Dim w As Workbook
Dim ws As Worksheet
Dim ButtonText As String
Dim fr1 As Long
Dim lr1 As Long
Dim i As Long
Dim wss As Worksheet
Dim cl As Range
Dim rr2 As Range
Dim fr2 As Long
Dim lr2 As Long
Dim cst As String
Dim r As Range
Dim v As String
Dim dtrr As Range
Dim cl2 As Range
Dim r2 As Range
Dim bt2 As Shape
Dim btc As Shape
Dim ld As Long
Dim ind As Range
Dim acr As Range
Dim cmb As Shape
Dim cmb2 As Shape
Dim j As Long

Set w = Workbooks("MCC_LEDGER.xlsm")
Set ws = w.ActiveSheet
Set wss = w.Worksheets("LIST")

fr1 = ws.UsedRange.Rows(ws.UsedRange.Rows(1).Count).Row
lr1 = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
fr2 = wss.UsedRange.Rows(wss.UsedRange.Rows(1).Count).Row
lr2 = wss.UsedRange.Rows(wss.UsedRange.Rows.Count).Row

ButtonText = Application.Caller

For i = fr1 To lr1
 If StrComp(ButtonText, ws.Cells(i, 2).Value) = 0 Then
   Exit For
 End If
Next

ws.Range("A" & i + 4).EntireRow.Insert

ld = ldn + 1

With ws.Range("P" & i + 4)
  ws.Buttons.Add(.Left, .Top, .Width, .Height).Name = CStr(ld)
End With

Set btc = ws.Shapes(CStr(ld))

btc.AlternativeText = "Calculate amount,cess, bill amount etc."
btc.Select
Selection.Characters.Text = "CALCULATE" '<<--- calculate button          would come before ld. no. ideally for worksheet change event to work easily.

With Selection.Font
    .Name = "ArialNarrow"
    .Size = 10
End With
 
btc.OnAction = "'" & w.Name & "'!clc"

ws.Range("E" & i + 4) = Day(Date) '<<---- date would come before ld     no. for undo to function.
ws.Range("D" & i + 4) = ld
要添加验证的第二个范围名为“acr”


更新-已按要求输入完整代码。

之后添加
DoEvents
。删除
并再次测试它?是
pos
合并单元格吗?@Sacru2red-否。@SiddharthRout-好的。。!!虽然我四处搜索,发现之前有pos.验证,但如果我添加pos.激活。。。它解决了我的问题。我不再犯错误了。做同样的事吗。?是否优于.activate。?错误通常是因为单元格中存在验证。
DoEvents
在应用新验证之前,为Excel提供删除验证的时间
激活
是个坏主意。如果此工作表在选择“锁定”选项时被隐藏或保护,该怎么办?您可能希望在
之后查看添加
DoEvents
。删除
并再次测试它?是否合并了
pos
单元格?@Sacru2red-否@SiddharthRout-好的。。!!虽然我四处搜索,发现之前有pos.验证,但如果我添加pos.激活。。。它解决了我的问题。我不再犯错误了。做同样的事吗。?是否优于.activate。?错误通常是因为单元格中存在验证。
DoEvents
在应用新验证之前,为Excel提供删除验证的时间
激活
是个坏主意。如果此工作表在选择“锁定”选项时被隐藏或保护,该怎么办?你可能想看看
Set ind = ws.Range("F" & i + 4)

ind.Activate

With ind.Validation
 .Delete
 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,Operator:=_
 xlBetween, Formula1:="DEBIT,CREDIT"
End With
cst = ""
Set rr2 = wss.Range("B" & fr2 + 1, "B" & lr2)

For Each r In rr2
  If cst = "" Then
   cst = CStr(r.Value)
  Else
   cst = cst & "," & CStr(r.Value)
  End If
Next r
Set acr = ws.Range("G" & i + 4)

acr.Activate

With acr.Validation
 .Delete
 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,Operator:=_
 xlBetween, Formula1:=cst
End With

lr1 = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row


With ws.Range("Q" & i + 4)
 ws.Buttons.Add(.Left, .Top, .Width, .Height).Name = CStr(ButtonText & "$" & ld)
End With

Set bt2 = ws.Shapes(CStr(ButtonText & "$" & ld))

bt2.AlternativeText = "Submit Entry"
bt2.Select
Selection.Characters.Text = "SUBMIT"

With Selection.Font
   .Name = "ArialNarrow"
   .Size = 12
End With
 
 bt2.OnAction = "'" & w.Name & "'!adentr"
 
 ws.Range("D" & i + 4).Select

 End Sub