0

このマクロは、特定の列の整数値に基づいて行を複製するのに最適です。元のデータのフォーマットもコピーするにはどうすればよいですか?

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
4

1 に答える 1

1

あなたが何を達成しようとしているのかよくわかりませんが、すべて（フォーマット、値など）をコピーしたい場合は、セルのCopyおよびPasteSpecial関数を使用します。

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

        Sheet1.Range("A" & currentNewSheetRow).Copy
        Sheet2.Range("A" & currentRow).PasteSpecial (xlPasteAll)
        Sheet1.Range("B" & currentNewSheetRow).Copy
        Sheet2.Range("B" & currentRow).PasteSpecial (xlPasteAll)
        Sheet1.Range("C" & currentNewSheetRow).Copy
        Sheet2.Range("C" & currentRow).PasteSpecial (xlPasteAll)

        currentNewSheetRow = currentNewSheetRow + 1

    Next i

Next currentRow

End Sub

また、PasteSpecial関数の可能なパラメーターを調べて、結果を達成します。

于 2012-07-18T17:02:29.243 に答える