2

行全体を別のワークシートにコピーする VBA Excel マクロを探しています。セルの整数値に基づいて、その行の追加の複製コピーを作成する必要があります。

これは、ドキュメントまたはラベルの複数のコピーを作成する差し込み印刷を使用する場合に役立ちます。近い回答がいくつか見つかりましたが、行全体をコピーするものはありません

入力
列 1 | col2 | col3 | col4
犬 | のように | 猫 | 猫 | 1
ラット | のように | ナッツ | 3
匹の猫 | かむ | ネズミ | 2

出力列 1 | col2 | col3 | col4
犬 | のように | ねこねこ
_ のように | ナッツ
ラット | のように | ナッツ
ラット | のように | ナッツ
猫 | かむ | ねずみ
猫 | かむ | ネズミ

出力 col4 の値が存在する可能性がありますが、私の場合は問題ではありません

4

3 に答える 3

1

データのあるシートの名前が「Sheet1」で、出力シートの名前が「Sheet2」であり、複製する回数が行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-17T15:03:22.800 に答える
0

現在アクティブなスプレッドシートから、選択した行のみで機能するようにフランシスの回答を調整しました。私の特定のユースケースでは、複製ごとに数量を 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-27T01:44:49.727 に答える