Excel VBA插入行异常：匹配条件时重复插入多行如何修复

Hey there! Let's break down why your code is inserting way more rows than you want, and fix it up properly.

The Problem with Your Current Code #

Your nested loops are causing two key issues:

1. Multiple matches trigger multiple inserts: Your inner loop runs from k=3 to k=20, so every time Cells(i,6) matches Cells(k,19), it runs the insert command. If there are 5 matching values in that range, you'll get 5 new rows instead of 1.
2. Row number shifting messes up your loop: When you insert a row below row i, all rows below it shift down by 1. Since you're looping i from 1 to 150, you'll end up skipping rows or processing the same row multiple times without realizing it.

Solution 1: Exit Inner Loop After First Match + Reverse Loop #

This approach stops the inner loop as soon as it finds a match, and processes rows from bottom to top to avoid row shifting issues:

For i = 150 To 1 Step -1
    For k = 3 To 20
        If Cells(i, 6).Value = Cells(k, 19).Value Then
            Cells(i, 6).EntireRow.Insert Shift:=xlDown
            Exit For ' Stop checking once we find the first match
        End If
    Next k
Next i

• Reverse loop (i=150 To 1 Step -1): When you insert a row below row i, it only affects rows below i—since we're starting from the bottom, those rows have already been processed, so no skipping occurs.
• Exit For: Ensures we only insert one row per matching i, even if multiple k values match.

Solution 2: Collect Rows First, Then Insert (More Efficient) #

For larger datasets, it's better to first collect all the rows that need inserting, then handle them in reverse order. This avoids modifying the worksheet while looping through it:

Dim rowsToInsert As Collection
Set rowsToInsert = New Collection

' First, gather all rows that meet the condition
For i = 1 To 150
    For k = 3 To 20
        If Cells(i, 6).Value = Cells(k, 19).Value Then
            rowsToInsert.Add i
            Exit For ' Only add each row once, even if multiple k matches
        End If
    Next k
Next i

' Insert rows from bottom to top
For i = rowsToInsert.Count To 1 Step -1
    Cells(rowsToInsert(i), 6).EntireRow.Insert Shift:=xlDown
Next i

This method is cleaner because it separates the "checking" logic from the "modifying" logic, making it easier to debug and maintain.

Key Takeaways #

• Always loop from bottom to top when inserting/deleting rows to avoid row number shifting issues.
• Use Exit For to stop inner loops once you've found the match you need, preventing duplicate actions.

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