簡體   English   中英

查看單元格中的數字 (x) 並復制行 (x) 次

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

所以我有這個 excel 電子表格,我需要拆分其中包含多個項目的某些組,因為它們將單獨處理。

這是一個示例表:

物品清單

詳細解釋需要發生的事情:

  1. 代碼從 B2 開始,到 B63 結束
  2. 對於每一行看 N
  3. 如果 N ISVALUE AND IS GREATER THEN 1 將工作表的 rest 向下移動 [N 值] 次,並在我們剛剛從向下移動(從 B 到 O)中清除的行中復制該行 [N 值] 次
  4. Go 到新添加的下一行,重復這個過程

如果代碼運行正常,結果應該如下:

預期結果

當我嘗試這樣做時出現的問題是我最終在我剛剛添加的行上運行我的代碼,並且我 go 進入無限循環。 提前感謝您的幫助!

編輯:我的代碼:

  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

根據我上面得到的評論,我想出了這個解決方案來稍微優化代碼。 對於我需要做的事情,似乎工作得很好。 我希望這可以幫助其他有類似斗爭的人。

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM