Excel VBA实现数值块添加删除功能的代码问题咨询

代码实现 #

新增数值块代码（优化后） #

Sub AddLibs()
    Dim r As ListObject
    Dim startRow As Long, endRow As Long, i As Long
    Dim blockRows As Range
    
    ActiveSheet.Unprotect "test"
    Set r = ActiveSheet.ListObjects("data")
    
    ' 定位选中单元格所属数值块的起止行（判定规则：连续非空行，上下为空行/表格边界）
    startRow = ActiveCell.Row
    ' 向上找块的起始边界
    Do While startRow > r.HeaderRowRange.Row + 1 And r.DataBodyRange.Cells(startRow - r.HeaderRowRange.Row, 1) <> ""
        startRow = startRow - 1
    Loop
    ' 向下找块的结束边界
    endRow = ActiveCell.Row
    Do While endRow < r.Range.Rows.Count And r.DataBodyRange.Cells(endRow - r.HeaderRowRange.Row, 1) <> ""
        endRow = endRow + 1
    Loop
    
    ' 选中整个数值块
    Set blockRows = r.Range.Rows(startRow & ":" & endRow)
    blockRows.Copy
    
    ' 在块下方先插入1行空分隔行，再插入复制的数值块
    r.Range.Rows(endRow + 1 & ":" & endRow + 1).Insert Shift:=xlDown
    r.Range.Rows(endRow + 2 & ":" & endRow + 1 + blockRows.Rows.Count).Insert Shift:=xlDown
    blockRows.Copy Destination:=r.Range.Rows(endRow + 2)
    
    ' 清理剪切板
    Application.CutCopyMode = False
    ' 重置表格范围
    r.Resize r.Range.Resize(r.Range.Rows.Count + blockRows.Rows.Count + 1)
    
    ActiveSheet.Protect "test", True, True
End Sub

删除数值块代码 #

Sub DeleteLibs()
    Dim r As ListObject
    Dim startRow As Long, endRow As Long
    
    ActiveSheet.Unprotect "test"
    Set r = ActiveSheet.ListObjects("data")
    
    ' 定位选中单元格所属数值块的起止行
    startRow = ActiveCell.Row
    Do While startRow > r.HeaderRowRange.Row + 1 And r.DataBodyRange.Cells(startRow - r.HeaderRowRange.Row, 1) <> ""
        startRow = startRow - 1
    Loop
    endRow = ActiveCell.Row
    Do While endRow < r.Range.Rows.Count And r.DataBodyRange.Cells(endRow - r.HeaderRowRange.Row, 1) <> ""
        endRow = endRow + 1
    Loop
    
    ' 删除数值块+下方的分隔空行，保留最后一个块的边界
    If endRow + 1 <= r.Range.Rows.Count Then
        r.Range.Rows(startRow & ":" & endRow + 1).Delete
    Else
        r.Range.Rows(startRow & ":" & endRow).Delete
    End If
    
    ActiveSheet.Protect "test", True, True
End Sub

使用说明 #

• 代码默认判定数值块的规则为「连续A列非空的行」，如果你的数值块判定逻辑不同，可以自行修改判定条件里的列号和空值规则
• 进入Excel开发工具选项卡，插入两个表单控件按钮，分别绑定AddLibs和DeleteLibs宏，修改按钮显示文本为「添加」「删除」即可使用
• 操作时只需点击目标数值块内的任意单元格，再点击对应按钮即可完成增删，无需选中整行/整个块
• 代码中默认的工作表保护密码为test，结构化表名称为data，如果你的实际场景配置不同，替换对应参数即可

内容的提问来源于stack exchange，提问作者Angelo Uitz