VBA代码优化：实现将含指定文本的行固定至第10行

原代码存在两个核心问题导致循环挂起：

• 当目标行（含“Area of Activity”）在第10行之后时，第一个Do While循环会无限执行：因为此时A10单元格永远不是目标文本，循环会持续在顶部插入行，陷入死循环。
• 第二个删除行的循环逻辑错误：删除第10行无法将下方的目标行移动到第10行，反而会让目标行的行号不断递减，但循环条件始终检查A10，逻辑混乱。

优化方案 #

先定位到目标行的准确行号，再根据行号与第10行的关系执行对应操作，避免无意义的循环：

1. 查找包含“Area of Activity”的行（精确匹配）
2. 根据目标行号与10的大小关系，选择插入行或删除行的操作
3. 全程避免依赖Activate，直接通过工作表对象操作，提升稳定性

修复后的完整代码 #

Sub SetUp()
    Dim sourceBook As Workbook
    Dim targetBook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim targetRow As Long
    Dim i As Long
    Dim answer1 As Integer
    Dim answer2 As Integer
    Dim answer3 As Integer
    Dim answer4 As Integer
    Dim crccc As Variant
    Dim crcac As Variant

    ' 检查是否仅打开两个工作簿
    If Workbooks.Count <> 2 Then
        MsgBox "运行此宏必须恰好打开两个工作簿", vbCritical + vbOKOnly, "从源工作簿复制列到目标工作簿"
        Exit Sub
    End If

    ' 设定源和目标工作簿
    Set targetBook = ActiveWorkbook
    If Workbooks(1).Name = targetBook.Name Then
        Set sourceBook = Workbooks(2)
    Else
        Set sourceBook = Workbooks(1)
    End If

    ' 设定工作表
    Set sourceSheet = sourceBook.ActiveSheet
    Set targetSheet = targetBook.ActiveSheet

    ' 关闭屏幕更新提升运行速度
    Application.ScreenUpdating = False

    ' 查找包含"Area of Activity"的行（精确匹配A列）
    On Error Resume Next
    targetRow = sourceSheet.Columns("A").Find(What:="Area of Activity", LookIn:=xlValues, LookAt:=xlWhole).Row
    On Error GoTo 0

    ' 检查是否找到目标行
    If targetRow = 0 Then
        MsgBox "未找到包含""Area of Activity""的行", vbExclamation + vbOKOnly, "提示"
        Application.ScreenUpdating = True
        Exit Sub
    End If

    ' 根据目标行位置执行操作
    If targetRow < 10 Then
        ' 目标行在第10行之前：在顶部插入行，将目标行推到第10行
        sourceSheet.Rows("1:" & (10 - targetRow)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ElseIf targetRow > 10 Then
        ' 目标行在第10行之后：删除第10行到目标行上方的所有行，将目标行移到第10行
        sourceSheet.Rows("10:" & (targetRow - 1)).Delete Shift:=xlUp
    End If

    ' 恢复屏幕更新
    Application.ScreenUpdating = True
End Sub

代码说明 #

• 使用Find方法精准定位目标行，避免循环遍历的低效和死循环风险
• 插入/删除行时直接计算需要操作的行数，一次性完成，提升效率
• 加入错误处理：如果未找到目标行，弹出提示并终止宏
• 关闭屏幕更新减少界面闪烁，提升运行速度

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