Excel根据匹配量添加和复制行值

Question

首先，我对VB完全陌生，并且对Excel没有太多经验。 其次，我不确定这是否是提出此问题的正确论坛，但是我看到了有关我的问题的更多问题。

我有一个带有两列ID的Excel工作表。像这样：

如您在第一张图片中（在第1列中看到的），您有3个相等的ID（蓝色）。在第二列中，您只有一次具有相同的ID（在第二行）。有没有一种方法可以创建某种功能来将第二列重复多少次呢？ 因此，它看起来像第二张图片：

编辑：函数/公式的思想是行向下移位。并非列1中的每个ID都有多个相同的ID。例如，黑色单元格只是一个单元格。另外的A列用作参考，只有b到F列应被“更改”。

我尝试使用Kutools之类的程序来完成此操作，但未成功。由于工作表大约有15,000行，因此手工处理会花费很多时间。

当单元格与值匹配时，我可以用VB添加一个空行，但是我无法复制。

我尝试了这显然不起作用：

Sub BlankLine()

    Dim Rng As Range
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId                   = "MyTest"
    Set WorkRng                = Application.Selection
    Set WorkRng                = Application.InputBox("Range", xTitleId, WorkRng.Address, Type: = 8)
    Set WorkRng                = WorkRng.Columns(1)
    xLastRow                   = WorkRng.Rows.Count
    Application.ScreenUpdating = False
    For xRowIndex = xLastRow To 1 Step - 1
        Set Rng                   = WorkRng.Range("A" & xRowIndex)
        If Rng.Value = "0" Then
            Rng.Offset(1, 0).EntireRow.Insert Shift: = xlDown
        End If
    Next
    Application.ScreenUpdating = True
End Sub

这是否有可能，有人愿意给出指示吗？预先感谢...

Answer 1

这是一个小例子-无法看到更多数据，就不可能知道从这里到哪里。

Sub Test()

Dim i As Long
Dim id As String

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    id = Cells(i, 1).Value
    If Cells(i + 1, 1).Value = id And Cells(i + 1, 2).Value <> id Then
        Range(Cells(i + 1, 2), Cells(i + 1, 6)).Insert Shift:=xlDown
        Range(Cells(i + 1, 2), Cells(i + 1, 6)).Value = Range(Cells(i, 2), Cells(i, 6)).Value
    End If
Next i

End Sub