VBA - 删除列/复选框/行期间出现未知变量错误（以前的工作代码）

Question

我在过去的问题上得到了慷慨的帮助（请参阅：将标题添加到最后一列一次并将复选框添加到最后一列的某些行），现在我正在添加它，我遇到了可变错误并且无法弄清楚如何来解决它。

---

代码当前目标：

1. 将数组与隐藏管理 ws 中的范围进行比较（范围是列表框选择 - 最多允许 4 个选择）

2. 如果做出了适用的选择（并记录在隐藏的ws中），将与

   进行比较

   表 1) 表格标题，查看是否需要在表格末尾添加新的列标题（以及边框和复选框）

   表2）另一表（不同的ws）行在单列中，以查看是否需要将新行/行项目添加到表中

此外，如果用户返回源列表框并取消选择某个项目，则会影响 2 个表：

  Table 1) applicable table header and assoc. column & checkboxes removed 
  Table 2) applicable row/line item removed from table

---

问题：

添加到表格中效果很好，但我在“删除”过程中遇到了麻烦。自从得到帮助（添加到其中）以来，我已经更新了代码，但仍保留推荐的结构。

我从 c 变量开始作为 Range，但尝试了 Long/Variant 只是为了看看我会得到什么，看看我是否能理解发生了什么，但目前我什么也不理解。

各种变量错误：

---

代码：

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

---

编辑

Answer 1

不要使用

On Error resume Next

，请考虑添加一个 Sub，如下所示：

'Delete any checkbox linked to cell `c`
Function DeleteLinkedCheckbox(c As Range)
    Dim cb As Object
    Set cb = CellCheckbox(c)
    If Not cb Is Nothing Then cb.Delete
End Function

然后代替这个：

On Error Resume Next
CellCheckbox(c).Delete  
c.ClearContents
'...
'...
On Error Got 0

您可以拨打电话

DeleteLinkedCheckbox c
c.ClearContents
'etc