Excel VBA在含指定值单元格下插2行时死循环、行数异常问题

• 遍历逻辑存在根本性缺陷：使用For Each从上到下遍历UsedRange时，每在匹配到"yes"的单元格下方插入2行，匹配位置下方的所有单元格都会被整体向下推移，新插入的空白行、原本已经遍历过的下方单元格会被循环重复读取。
• 死循环触发逻辑：插入操作会不断扩展UsedRange的覆盖范围，循环永远走不到遍历终点，就会出现无限运行、插入行数远多于2行的问题。
• 额外逻辑瑕疵：原代码中InStr未指定比较模式和起始位置，默认区分大小写，且只要单元格任意位置包含"yes"子串就会触发插入（比如值为"yesterday"的单元格也会被匹配），可根据实际需求调整匹配规则。

核心修复逻辑：从已使用区域的最后一行向上倒序遍历，插入行时只会影响还没遍历到的下方区域，不会干扰已遍历过的行位置，从根源上避免重复遍历、重复插入的问题。
可直接使用的代码如下：

Sub InsertRowsBelowYesCells()
    Dim targetWs As Worksheet
    Dim lastUsedRow As Long
    Dim i As Long, cell As Range
    Dim matchFlag As Boolean
    
    ' 若需指定工作表，把下一行替换为 Set targetWs = Sheets("你的工作表名")
    Set targetWs = ActiveSheet
    ' 计算当前工作表已使用区域的最后一行行号
    lastUsedRow = targetWs.UsedRange.Row + targetWs.UsedRange.Rows.Count - 1
    
    ' 从最后一行向上逐行遍历
    For i = lastUsedRow To 1 Step -1
        matchFlag = False
        ' 检查当前行是否存在包含"yes"的单元格
        For Each cell In targetWs.Rows(i).Cells
            ' 不区分大小写匹配，若需区分大小写删除最后一个参数vbTextCompare即可
            If InStr(1, cell.Value, "yes", vbTextCompare) > 0 Then
                matchFlag = True
                Exit For
            End If
        Next cell
        
        ' 匹配到的话，在当前行下方插入2个空白行
        If matchFlag Then
            targetWs.Rows(i + 1).Resize(2).Insert Shift:=xlDown
        End If
    Next i
End Sub

使用说明 #

• 如果需要精确匹配单元格值完全等于"yes"（排除"yes123""yesterday"这类包含子串的情况），把InStr判断语句替换为If cell.Value = "yes" Then即可。
• 操作前建议先备份数据，避免批量操作失误导致内容丢失。

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