Excel 如果值大于或等于，则在下方插入空白单元格的宏；1并从上面的单元格复制/粘贴值

该网站已经有类似的功能：

但是代码并没有把我带到我需要去的地方，而且我还没有能够调整它使它适合我

我的用户的工作表有4列，a-D。a列包含特定的合同编号，B列为空，C列包含零件编号，D列包含整个合同编号范围。我的用户想要计算整个范围内合同编号重复的次数，因此我在单元格E2中输入公式

=countif（$D$2:$D$100000，A2）

，然后向下复制，给出A列中的特定合同在D列中出现的次数。此工作簿中的数字范围为1到11，但此方法将在其他工作簿中使用的数字可能更高

我需要做的下一件事是在E列中大于1的所有值下方输入空白单元格，这与前面问题中的示例非常相似。然后，我还需要在同一行中复制，并在A列的同一行中插入完全匹配的复制单元格。例如：单元格E21的数字为5，因此我只需要移动E列中的单元格，以便在其正下方有4个空白单元格。在A列中，我需要复制单元格A21，并在正下方的四行中插入复制的单元格

只是尝试让空白单元格插入，已经是一个试验，使用前面的问题中给出的代码。

    Dim sh As Worksheet
    Dim lo As ListObject
    Dim rColumn As Range
    Dim i As Long
    Dim rws As Long

    Set sh = ActiveSheet
    Set lo = sh.ListObjects("Count")

    Set rColumn = lo.ListColumns("Count").DataBodyRange
    vTable = rColumn.Value

    For i = rColumn.Rows.Count To 1 Step -1
        If rColumn.Cells(i, 1) > 1 Then
            rws = rColumn.Cells(i, 1) - 1
            With rColumn.Rows(i)
                .Offset(1, 0).Resize(rws, 1).Cells.Insert
                .EntireRow.Copy .Offset(1, 0).Resize(rws, 1).Cells
                .Offset(1, 0).Resize(rws, 1).EntireRow.Font.Strikethrough = True
            End With
        End If
    Next

---

我将非常感谢您的帮助，因为我已经与这个怪物战斗了一周。

虽然这确实是可行的，但最好将所有合同编号的列表从D列移到另一张表中。尽管循环遍历一个区域并根据单元格值插入行非常简单，但它也会在列D和E中创建孔

下面的代码用于简单地添加行并按照指定复制值

Sub Main()

'---Variables---
Dim source As Worksheet
Dim startRow As Integer
Dim num As Integer
Dim val As String
Dim i As Long


'---Customize---
Set source = ThisWorkbook.Sheets(1) 'The sheet with the data
startRow = 2 'The first row containing data


'---Logic---
i = startRow 'i acts as a row counter
Do While i <= source.Range("E" & source.Rows.Count).End(xlUp).Row
'looping until we hit the last row with a value in column E
    num = source.Range("E" & i).Value 'Get number of appearances
    val = source.Range("A" & i).Value 'Get the value
    If num > 1 Then 'Number of appearances > 1
        Do While num > 1 'Create rows
            source.Range("A" & i + 1).EntireRow.Insert 'Insert row
            source.Range("A" & i + 1) = val 'Set value
            num = num - 1
            i = i + 1 'Next row
        Loop
    End If
    i = i + 1 'Next row
Loop

End Sub

Sub-Main（）
“---变量---
将源设置为工作表
Dim startRow为整数
Dim num作为整数
作为字符串的Dim val
我想我会坚持多久
---定制---
设置source=ThisWorkbook.Sheets（1）'包含数据的工作表
startRow=2'包含数据的第一行
---逻辑---
i=startRow‘i用作行计数器
趁我不在的时候做
当num>1'创建行时执行
source.Range（“A”&i+1）.EntireRow.Insert“插入行”
source.Range（“A”&i+1）=val'设定值
num=num-1
i=i+1'下一行
环
如果结束
i=i+1'下一行
环
端接头

当然，您也可以在插入新行后删除列D中的孔，并修改列E中的公式，使其保持可复制状态，并且不计算复制的行

---

一般来说，如果一行可以看作是一个对象，那么事情就会变得更容易，因为创建或删除一行只会影响一个对象。在这里，我们有一行表示特定合同和所有合同列表中的合同-这可能会导致以后的问题（或者完全没有问题！）

请检查我的理解，因此对于E列中大于1的任何单元格（即与唯一合同id相关的多个合同？）您希望输入一个新行=合同数量减去1（例如，如果数字为4，则输入3个新行）。然后要将前3列中的信息复制到这些新的空白单元格中？A列有一个特定合同编号的简短列表，必须与D列中的整个列表进行比较。我在E列中输入了一个公式，以计算合同编号在D列中出现的次数。我需要在任何大于1，等于计数减1。在A列的同一行中，我需要将值复制到与>1计数相同的行上，并将复制的单元格插入到该值下方的单元格中。例如：如果E21包含3，则在下面插入2个空白单元格，然后复制A21并插入复制的单元格A22和A23。我们不希望插入整行，只希望插入单元格。很高兴您发现它很有用！