1

我正在尝试设置一个查找列“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
4

1 回答 1

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
于 2013-10-22T01:40:06.303 回答