如何在重复批次ID的最后一行后插入新行而非每个唯一ID后？

你的核心需求是仅在出现过多次的批次ID的最后一行后插入新行，原代码的问题在于它会给每个唯一ID（包括只出现一次的）都添加新行，不符合要求。以下是修改后的代码，完全匹配你的需求：

Public Sub InsertAfterLastDuplicateID()
'仅在重复批次ID的最后一行后插入新行

Dim Rng As Range
Dim WorkRng As Range
Dim xTitleId As String
Dim i As Long '改用Long避免行数过多时溢出

On Error Resume Next
xTitleId = "选择目标范围"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False

'倒序遍历，避免插入行影响后续行号的判断
For i = WorkRng.Rows.Count To 2 Step -1
    '判断当前行是否是重复ID的最后一行
    '情况1：当前行是最后一行，且和上一行值相同（最后一组是重复ID）
    If i = WorkRng.Rows.Count Then
        If WorkRng.Cells(i, 1).Value = WorkRng.Cells(i - 1, 1).Value Then
            WorkRng.Cells(i + 1, 1).EntireRow.Insert
        End If
    '情况2：当前行不是最后一行，且和上一行值相同、和下一行值不同（当前是该重复ID的最后一个）
    Else
        If WorkRng.Cells(i, 1).Value = WorkRng.Cells(i - 1, 1).Value And _
           WorkRng.Cells(i, 1).Value <> WorkRng.Cells(i + 1, 1).Value Then
            WorkRng.Cells(i + 1, 1).EntireRow.Insert
        End If
    End If
Next

Application.ScreenUpdating = True

End Sub

代码逻辑说明 #

1. 倒序遍历：从最后一行往第一行遍历，这样插入新行不会打乱后续待处理的行号，保证判断准确。
2. 两种判断场景：
   • 当遍历到最后一行时，只需检查它和上一行的值是否相同（说明最后一组是重复ID），若是则在最后一行后插入新行。
   • 当遍历到中间行时，需要同时满足两个条件：当前行和上一行值相同（属于重复ID序列）、当前行和下一行值不同（是该序列的最后一个），满足则插入新行。

测试你的示例数据 #

对于你给出的列表：

1
2
3
3
4
5
6
6
6
7

运行代码后，会在第2个3（第4行）和第3个6（第9行）之后分别插入新行，最终结果如下：

1
2
3
3

4
5
6
6
6

7

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