You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

VBA移除列/复选框/行时出现未知变量错误(原代码曾正常运行)

问题:移除复选框时的变量错误及残留问题

背景

此前在相关问题中获得过帮助,如今扩展代码后出现变量错误,无法解决。

代码目标

  1. 将数组与隐藏的Admin工作表中的Range(存储列表框选中项,最多4项)进行比对
  2. 若存在选中项,执行以下操作:
    • Table 1:检查表格表头,判断是否需在末尾添加列标题、边框及复选框
    • Table 2:检查另一工作表表格的单列行,判断是否需添加新行
  3. 当用户取消列表框选中项时,执行移除操作:
    • 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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.08 12:55:57