根据列中的值复制和插入行

我试图build立一个查找列“G”中的单元格的过程，如果一个值大于1，复制整个表格行，插入一行（根据数值多次 – 1），并粘贴该值到每个新插入的行中。

所以，如果单元格“G4”中有3个数量，那么我想复制该单元格的行，并在其下面插入一行2次并粘贴复制的值。

以下是我到目前为止…

**请注意，所有这些都在Excel表格中。 （不知道这是否是我的代码的问题）

Dim Qty As Range For Each Qty In Range("G:G").cells If Qty.Value > 1 Then Qty.EntireRow.cell Selection.Copy ActiveCell.Offset(1).EntireRow.Insert Selection.Paste Selection.Font.Strikethrough = True End If Next End Sub 

Answer 1

你的方法和代码有很多问题

1. 你说数据在Excel表格中。 使用这个你的优势
2. 从下往上将行插入范围循环中。 这可以防止插入的行干扰循环索引
3. 不要使用Selection （即使你的逻辑不操作ActiveCell）
4. 不要遍历整个列（即一百万行）。 将其限制为表格大小

这是对这些想法的展示

 Sub Demo() Dim sh As Worksheet Dim lo As ListObject Dim rColumn As Range Dim i As Long Dim rws As Long Set sh = ActiveSheet ' <-- adjuct to suit Set lo = sh.ListObjects("YourColumnName") Set rColumn = lo.ListColumns("YourColumnName").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).EntireRow.Insert .EntireRow.Copy .Offset(1, 0).Resize(rws, 1).EntireRow .Offset(1, 0).Resize(rws, 1).EntireRow.Font.Strikethrough = True End With End If Next End Sub