Excel vba宏根據單元格整數值多次複製行

我正在查找將完整行復制到另一個工作表的VBA Excel宏。它需要根據單元整數值創建該行的其他重複副本。Excel vba宏根據單元格整數值多次複製行

當您想要創建文檔或標籤的多個副本時使用郵件合併時，這會很有幫助。我發現幾個答案是接近的，但沒有任何複製整行

輸入
col1 | col2 | col3 | col4
狗|像|一樣貓| 1
大鼠|像|一樣堅果| 3
貓|嚼|大鼠| 2

輸出 col1 | col2 | col3 | col4
狗|像|一樣貓
大鼠|像|一樣堅果
大鼠|像|一樣堅果
大鼠|像|一樣堅果
貓|嚼|大鼠
貓|嚼|大鼠

值在輸出COL4可能存在，無所謂我的情況

2012-07-17 Dave

假定與數據片的名稱爲「表Sheet 1」，輸出片材的名稱爲「Sheet 2中」和量重複次數位於D行 - 此代碼將起作用。您需要先修改它以滿足您的需求！

Sub DuplicateRows() 

Dim currentRow As Integer 
Dim currentNewSheetRow As Integer: currentNewSheetRow = 1 

For currentRow = 1 To 3 'The last row of your data 

    Dim timesToDuplicate As Integer 
    timesToDuplicate = CInt(Sheet1.Range("D" & currentRow).Value2) 

    Dim i As Integer 
    For i = 1 To timesToDuplicate 

     Sheet2.Range("A" & currentNewSheetRow).Value2 = Sheet1.Range("A" & currentRow).Value2 
     Sheet2.Range("B" & currentNewSheetRow).Value2 = Sheet1.Range("B" & currentRow).Value2 
     Sheet2.Range("C" & currentNewSheetRow).Value2 = Sheet1.Range("C" & currentRow).Value2 

     currentNewSheetRow = currentNewSheetRow + 1 

    Next i 

Next currentRow 

End Sub

來源

2012-07-17 15:03:22

我已經做了一些改變和調整弗朗西斯院長回答：

對於那些在辦公室2013（？或2010），Excel中需要明確的是「工作表Sheet1」這個名字知道的工作表。
此外，我修改了更多的行和列的宏。例如currentRow是Long，最後一行是Integer+1。
我確定重複的整數值在「J」中。

宏則是：

Sub DuplicateRows() 
    Dim currentRow As Long 
    Dim currentNewSheetRow As Long: currentNewSheetRow = 1 

    For currentRow = 1 To 32768 'The last row of your data 
    Dim timesToDuplicate As Integer 
    timesToDuplicate = CInt(Worksheets("Sheet1").Range("J" & currentRow).Value) 
    Dim i As Integer 
    For i = 1 To timesToDuplicate 
     Worksheets("Sheet2").Range("A" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("A" & currentRow).Value 
     Worksheets("Sheet2").Range("B" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("B" & currentRow).Value 
     Worksheets("Sheet2").Range("C" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("C" & currentRow).Value 
     Worksheets("Sheet2").Range("D" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("D" & currentRow).Value 
     Worksheets("Sheet2").Range("E" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("E" & currentRow).Value 
     Worksheets("Sheet2").Range("F" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("F" & currentRow).Value 
     Worksheets("Sheet2").Range("G" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("G" & currentRow).Value 
     Worksheets("Sheet2").Range("H" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("H" & currentRow).Value 
     Worksheets("Sheet2").Range("I" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("I" & currentRow).Value 
     currentNewSheetRow = currentNewSheetRow + 1 
    Next i 
Next currentRow 
End Sub

來源

2013-06-13 16:42:51 Blogisch

我

適於Francis的答案從當前活動的電子表格和只在選定的行工作。我的特殊用例要求將每個副本的數量更改爲1，因此「G」列設置爲1.

它仍然只適用於固定的一組列。

Sub MultiplySelectedRows() 
'store reference to active sheet 
Dim Source As Worksheet 
Set Source = ActiveWorkbook.ActiveSheet 
'create new sheet for output 
Dim Multiplied As Worksheet 
Set Multiplied = Sheets.Add(After:=Worksheets(Worksheets.Count)) 
'switch back to original active sheet 
Source.Activate 
Dim rng As Range 
Dim lRowSelected As Long 
Dim duplicateCount As Integer 
Dim newSheetRow As Integer 
newSheetRow = 1 
For Each rng In Selection.Rows 
    lRowSelected = rng.Row 
    'Column holding number of times to duplicate each row is specified in quotes 
    duplicateCount = CInt(Source.Range("G" & lRowSelected).Value) 
    Dim i As Integer 
    For i = 1 To duplicateCount 
     'one copy statement for each column to be copied 
     Multiplied.Range("A" & newSheetRow).Value = Source.Range("A" & lRowSelected).Value 
     Multiplied.Range("B" & newSheetRow).Value = Source.Range("B" & lRowSelected).Value 
     Multiplied.Range("C" & newSheetRow).Value = Source.Range("C" & lRowSelected).Value 
     Multiplied.Range("D" & newSheetRow).Value = Source.Range("D" & lRowSelected).Value 
     Multiplied.Range("E" & newSheetRow).Value = Source.Range("E" & lRowSelected).Value 
     Multiplied.Range("F" & newSheetRow).Value = Source.Range("F" & lRowSelected).Value 
     'multiplier is replaced by 1 (16x1 instead of 1x16 lines) 
     Multiplied.Range("G" & newSheetRow).Value = 1 
     Multiplied.Range("H" & newSheetRow).Value = Source.Range("H" & lRowSelected).Value 
     Multiplied.Range("I" & newSheetRow).Value = Source.Range("I" & lRowSelected).Value 
     Multiplied.Range("J" & newSheetRow).Value = Source.Range("J" & lRowSelected).Value 
     Multiplied.Range("K" & newSheetRow).Value = Source.Range("K" & lRowSelected).Value 
     Multiplied.Range("L" & newSheetRow).Value = Source.Range("L" & lRowSelected).Value 
     newSheetRow = newSheetRow + 1 
    Next i 
Next rng

結束子

來源

2014-06-27 01:44:49 epakai

Excel vba宏根據單元格整數值多次複製行

回答

相關問題