简体   繁体   中英

Look at number (x) in a cell and copy the row (x) times

So I have this excel spreadsheet where I need to split certain groups that have more than one item inside them as they will be worked on individually.

Here is an example sheet:

物品清单

Explanation in detail of what needs to happen:

  1. Code starts at B2 and ends at B63
  2. For each row look in N
  3. If N ISVALUE AND IS GREATER THEN 1 move the rest of the sheet down [value of N] times and copy that row [value of N] times in the rows we just cleared from moving down (from B to O)
  4. Go to the row under the newly added one, and repeat the process

IF the code has run properly the result should be the following:

预期结果

The problem that occurs when I try to do it is that I end up running my code on the lines I just added and I go into an infinite loop. Thank you in advance for the help!

EDIT: The code I have:

  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

Based off the comments I got above I came up with this solution to optimize the code a little. Seems to be working just fine for what I needed to do. I hope this helps anyone else with a similar struggle.

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM