VBA移除列/复选框/行时出现未知变量错误(原代码曾正常运行)
问题:移除复选框时的变量错误及残留问题
背景
此前在相关问题中获得过帮助,如今扩展代码后出现变量错误,无法解决。
代码目标
- 将数组与隐藏的Admin工作表中的Range(存储列表框选中项,最多4项)进行比对
- 若存在选中项,执行以下操作:
- Table 1:检查表格表头,判断是否需在末尾添加列标题、边框及复选框
- Table 2:检查另一工作表表格的单列行,判断是否需添加新行
- 当用户取消列表框选中项时,执行移除操作:
- Table 1:移除对应表头、列及关联复选框
- Table 2:移除对应行
问题现象
添加功能正常,但移除过程中出现变量错误,且移除后仍有复选框残留。尝试将变量c设置为不同类型时,分别出现以下错误:
- 设为Range:对象变量或With块变量未设置
- 设为Long:控制变量必须为Variant或Object
- 设为Variant:ByRef参数类型不匹配
错误出现在移除逻辑中的CellCheckbox(c).Delete语句处。
完整代码
Sub IP_AO_Update() Const AO_COL As Long = 4 Const HEADERS_ROW As Long = 6 Dim srcWS As Worksheet Dim aWS As Worksheet Dim targetWS As Worksheet Dim SelTerm As Variant Dim mSel As Variant Dim c As Variant 'Long 'Range Dim bLR As Long Dim dLR As Long Dim arrSel As Variant Dim colD As Range Dim targetLR As Long Dim arrAddOns As Variant Dim term As Variant Dim hdr As Variant Dim mHdr As Variant Dim rngCB As Range Set wb = ThisWorkbook Set aWS = wb.ActiveSheet Set targetWS = wb.Sheets(aWS.Index + 1) Set admin = wb.Worksheets("Admin") Set SelRng = admin.Range("AF2:AF5") Set colD = targetWS.Range("D7:D10") With Application .ScreenUpdating = False End With arrAddOns = Array("Implant Add On", "High Cost Drug Add On", "Postpartum LARC Add On", "Renal Dialysis Add On") For Each term In arrAddOns 'Apply [AO]:' hdr = HeaderText(term) mHdr = Application.Match(hdr, aWS.Rows(HEADERS_ROW), 0) If Not IsError(Application.Match(term, SelRng, 0)) Then If IsError(mHdr) Then ' + AO hdr mHdr = aWS.Cells(HEADERS_ROW, Columns.Count).End(xlToLeft).Column + 1 ' + AO col bordering With aWS.Cells(HEADERS_ROW, mHdr) .Value = hdr .HorizontalAlignment = xlCenter .VerticalAlignment = xlTop .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlEdgeTop).Weight = xlThin .Borders(xlEdgeTop).ColorIndex = 15 .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeBottom).Weight = xlThin .Borders(xlEdgeBottom).ColorIndex = 15 .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeRight).Weight = xlThin .Borders(xlEdgeRight).ColorIndex = 15 With Range(.Offset(1, 0), .Offset(22, 0)) .Borders(xlInsideHorizontal).LineStyle = xlContinuous .Borders(xlInsideHorizontal).Weight = xlThin .Borders(xlInsideHorizontal).ColorIndex = 15 .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeRight).Weight = xlThin .Borders(xlEdgeRight).ColorIndex = 15 .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeBottom).Weight = xlThin .Borders(xlEdgeBottom).ColorIndex = 15 End With End With ' + AO terms in AO ws mSel = targetWS.Cells(Rows.Count, AO_COL).End(xlUp).Row + 1 With targetWS .Cells(mSel, AO_COL).Value = term If .Cells(mSel, AO_COL).Value <> "" Then .Cells(mSel, 2).Value = "ADD ON" End If End With End If ' + cb For Each c In aWS.Range("B7:B" & aWS.Cells(Rows.Count, "B").End(xlUp).Row).Cells Set rngCB = c.EntireRow.Columns(mHdr) Set cb = CellCheckbox(rngCB) Debug.Print rngCB.Address, Not cb Is Nothing If cb Is Nothing Then AddCheckbox rngCB Next c '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Else If Not IsError(mHdr) Then For Each c In colD.EntireRow.Columns(mHdr).Cells On Error Resume Next ' - tbl AO hdr, cols, cb CellCheckbox(c).Delete 'The c variable starts to error here when c = Range c.ClearContents c.Borders(xlEdgeTop).LineStyle = xlNone c.Borders(xlEdgeBottom).LineStyle = xlNone c.Borders(xlEdgeRight).LineStyle = xlNone With Range(c.Offset(1, 0), c.Offset(22, 0)) c.Borders(xlEdgeRight).LineStyle = xlNone c.Borders(xlInsideHorizontal).LineStyle = xlNone End With On Error GoTo 0 Next c aWS.Columns(mHdr).Delete ' - rows in AO ws With targetWS For Each c In colD.EntireColumn.Rows(mSel).Cells c.ClearContents Next c .Rows(mSel).Delete End With End If End If Next term End Sub
内容的提问来源于stack exchange,提问作者StillLearningThisStuff
相关产品推荐
相关产品推荐

