Excel VBA需求：遍历单元格复制插入含值1的行并添加文本

原代码存在几个关键问题：变量声明与赋值不匹配、遍历方向错误（会导致重复处理插入的行）、依赖Select/Activate降低效率、未实现新行第13列插入指定文本的功能，且遍历起始行不符合需求（应该从第3行开始而非第4行）。以下是修正后的代码：

Sub Workcenter()
    Application.ScreenUpdating = False ' 关闭屏幕刷新提升运行效率
    Application.DisplayAlerts = False ' 关闭操作警告提示
    
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long, col As Long
    Dim targetText As String
    
    ' 自定义要插入到第13列的文本，可根据需求修改
    targetText = "你的指定文本"
    
    Set ws = ThisWorkbook.Worksheets("Test") ' 绑定目标工作表
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' 以第1列为基准获取数据最后一行
    
    ' 从最后一行往上遍历，避免插入新行后漏处理或重复处理同一行
    For i = lastRow To 3 Step -1
        ' 遍历1-8列查找值为1的单元格
        For col = 1 To 8
            If ws.Cells(i, col).Value = 1 Then
                ' 复制当前行并插入到下方
                ws.Rows(i).Copy
                ws.Rows(i + 1).Insert Shift:=xlDown
                ' 在新行的第13列（M列）插入指定文本
                ws.Cells(i + 1, 13).Value = targetText
                ' 找到一个1就停止当前行的列遍历，避免同一行多次插入
                Exit For
            End If
        Next col
    Next i
    
    ' 清理剪贴板，恢复Excel默认设置
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

关键修改说明： #

• 变量规范：统一使用ws指代工作表，解决原代码中变量声明与赋值不匹配的问题
• 遍历方向调整：从最后一行往上倒序遍历（Step -1），避免插入新行后行数增加导致的重复处理问题
• 移除Select/Activate：直接通过工作表对象操作单元格，提升代码运行效率和稳定性
• 实现指定文本插入：新增targetText变量，插入新行后直接给第13列赋值
• 遍历范围修正：起始行改为第3行，符合需求；以第1列为基准获取最后一行，避免某列数据不完整导致的错误
• 优化运行设置：结束后清理剪贴板，恢复屏幕刷新和警告提示

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