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

我正在尝试建立一个过程,该过程在“ G”列中查找单元格,如果值大于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
最佳答案
您的方法和代码有很多问题

>您说数据在Excel表中.利用这个优势
>将行从下往上插入范围循环时.这样可以防止插入的行干扰循环索引
>不要使用选择(即使您这样做也不会对ActiveCell进行操作)
>不要在整个列(即一百万行)上循环.将其限制为表格大小

这是这些想法的示范

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

转载注明原文:excel-根据列中的值复制和插入行 - 代码日志