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

b91juud3 于 2023-06-07 发布在其他

关注(0)|答案(1)|浏览(250)

我试图设置一个程序，查找列“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

excel

来源：https://stackoverflow.com/questions/19504741/copy-and-insert-rows-based-off-of-values-in-a-column

1条答案

按热度按时间

6ojccjat1#

您的方法和代码存在许多问题
1.你说数据在Excel表格中。好好利用这点
1.从下向上将行插入范围循环时。这可以防止插入的行干扰循环索引
1.不要使用Selection（即使使用了，您的逻辑也不会操作ActiveCell）
1.不要循环遍历整列（那是一百万行）。将其限制为表大小
下面是这些想法的演示

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

赞(0）回复(0）举报 2023-06-07

我来回答

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

1条答案

相关问题

热门标签

最新问答