时间戳

首页 > 解决方案 > 查看单元格中的数字 (x) 并复制行 (x) 次

excel - 查看单元格中的数字 (x) 并复制行 (x) 次

问题描述

所以我有这个 excel 电子表格，我需要在其中拆分包含多个项目的某些组，因为它们将单独处理。

这是一个示例表：

物品清单

详细解释需要发生的事情：

  1. 代码从 B2 开始，到 B63 结束
  2. 对于每一行看 N
  3. 如果 N ISVALUE AND IS GREATER THEN 1 将工作表的其余部分向下移动 [N 的值] 次，并将该行 [N 的值] 次复制到我们刚刚从向下移动中清除的行中（从 B 到 O）
  4. 转到新添加的下一行，并重复该过程

如果代码运行正常，结果应该如下：

预期结果

当我尝试这样做时出现的问题是我最终在我刚刚添加的行上运行我的代码，并且我进入了一个无限循环。预先感谢您的帮助！

编辑：我的代码：

  Sub Splitter()

    Dim i As Integer
    Dim j As Integer

    For i = 2 To 63
        
        If IsNumeric(Cells(i, 14).Value) And (Cells(i, 14).Value) > 1 Then
           If Cells(i, 3).Value = Cells(i - 1, 3).Value And Cells(i, 4).Value = Cells(i - 1, 4).Value Then
                
            Else:
                Cells(i + 1, 2).Select
                Range(Cells(i + 1, 2), Cells(62, 15)).Copy
                ActiveCell.Offset(Cells(i, 14).Value, 0).Range("A1").Select
                ActiveSheet.Paste
                Range(Cells(i, 2), Cells(i, 15)).Copy
                
                For j = 1 To Cells(i, 14).Value
                    ActiveCell.Offset(1, 0).Range("A1").Select
                    ActiveSheet.Paste
                Next j
                
            End If
        End If
    Next i
End Sub

标签： excelvba

解决方案

根据我上面得到的评论，我想出了这个解决方案来稍微优化代码。对于我需要做的事情，似乎工作得很好。我希望这可以帮助其他有类似斗争的人。

Sub Splitter()

    Dim i As Integer
    Dim j As Integer

    For i = 62 To 2 Step -1
        
        If IsNumeric(Cells(i, 14).Value) And (Cells(i, 14).Value) > 1 Then
                
                Range("C" & Rows.Count).End(xlUp).Select
                ActiveCell.Offset(0, 10).Range("A1").Select
                Range(Cells(i + 1, 2), ActiveCell).Copy
                Cells(i + 1, 2).Select
                ActiveCell.Offset(Cells(i, 14).Value - 1, 0).Range("A1").Select
                ActiveSheet.Paste
                
                Range(Cells(i, 2), Cells(i, 13)).Copy
                Cells(i, 2).Select
                
                For j = 1 To (Cells(i, 14).Value - 1)
                    ActiveCell.Offset(1, 0).Range("A1").Select
                    ActiveSheet.Paste
                Next j
                
        End If
    Next i
    Application.CutCopyMode = False
    Cells(1, 1).Select
    
End Sub

推荐阅读