web-dev-qa-db-ja.com

ExcelVBAの自動化-セルの値に基づいて行「x」を何度もコピーします

面倒なデータ入力の時間を数え切れないほど節約できる方法でExcelを自動化しようとしています。これが私の問題です。

すべての在庫のバーコードを印刷する必要があります。これには、それぞれ特定の数量の4,000のバリエーションが含まれています。

Shopifyは当社のeコマースプラットフォームであり、カスタマイズされたエクスポートをサポートしていません。ただし、在庫数列を含むすべてのバリアントのCSVをエクスポートできます。

バーコード印刷のハードウェア/ソフトウェアにはDymoを使用しています。 Dymoは、行ごとに1つのラベルのみを印刷します（数量列は無視されます）。

在庫列の値に基づいて行「x」を何度も複製するようにExcelを自動化する方法はありますか？

データのサンプルは次のとおりです。

https://www.evernote.com/shard/s187/sh/b0d5b92a-c5f6-469c-92fb-3d4e03d97544/d176d3448ba0cafbf3d61506402d9e8b/res/254447d2-486d-454f-8871-a0962f03253d/skitch.png

  • 列N = 0の場合、無視して次の行に移動します
  • 列N> 1の場合、現在の行「N」を（別のシートに）何度もコピーします。

コードを変更できるように、似たようなことをした人を見つけようとしましたが、1時間検索した後でも、開始した場所は正しいです。よろしくお願いします！

excelvbaautomationduplicatesrows
4
Judson Hanna

デビッドは私をそれに打ち負かしましたが、別のアプローチは誰も傷つけません。

次のデータを検討してください

Item           Cost Code         Quantity
Fiddlesticks   0.8  22251554787  0
Woozles        1.96 54645641     3
Jarbles        200  158484       4
Yerzegerztits  56.7 494681818    1

この機能で

Public Sub CopyData()
    ' This routing will copy rows based on the quantity to a new sheet.
    Dim rngSinglecell As Range
    Dim rngQuantityCells As Range
    Dim intCount As Integer

    ' Set this for the range where the Quantity column exists. This works only if there are no empty cells
    Set rngQuantityCells = Range("D1", Range("D1").End(xlDown))

    For Each rngSinglecell In rngQuantityCells
        ' Check if this cell actually contains a number
        If IsNumeric(rngSinglecell.Value) Then
            ' Check if the number is greater than 0
            If rngSinglecell.Value > 0 Then
                ' Copy this row as many times as .value
                For intCount = 1 To rngSinglecell.Value
                    ' Copy the row into the next emtpy row in sheet2
                    Range(rngSinglecell.Address).EntireRow.Copy Destination:= Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)                                
                    ' The above line finds the next empty row.

                Next
            End If
        End If
    Next
End Sub

Sheet2に次の出力を生成します

Item            Cost    Code        Quantity
Woozles         1.96    54645641    3
Woozles         1.96    54645641    3
Woozles         1.96    54645641    3
Jarbles         200     158484      4
Jarbles         200     158484      4
Jarbles         200     158484      4
Jarbles         200     158484      4
Yerzegerztits   56.7    494681818   1

このコードの注意点は、[数量]列に空のフィールドを含めることはできないということです。私はDを使用したので、お気軽にNに置き換えてください。

7
Matt

あなたが始めるのに十分なはずです：

Sub CopyRowsFromColumnN()

Dim rng As Range
Dim r As Range
Dim numberOfCopies As Integer
Dim n As Integer

'## Define a range to represent ALL the data
Set rng = Range("A1", Range("N1").End(xlDown))

'## Iterate each row in that data range
For Each r In rng.Rows
    '## Get the number of copies specified in column 14 ("N")
    numberOfCopies = r.Cells(1, 14).Value

    '## If that number > 1 then make copies on a new sheet
    If numberOfCopies > 1 Then
        '## Add a new sheet
        With Sheets.Add
            '## copy the row and paste repeatedly in this loop
            For n = 1 To numberOfCopies
                r.Copy .Range("A" & n)
            Next
        End With
    End If
Next

End Sub
2
David Zemens

答えるのが少し遅れるかもしれませんが、これは他の人を助けるかもしれません。このソリューションをExcel2010でテストしました。たとえば、「Sheet1」はデータが配置されているシートの名前であり、「Sheet2」は繰り返しデータが必要なシートです。これらのシートが作成されていると仮定して、以下のコードを試してください。

Sub multiplyRowsByCellValue()
Dim rangeInventory As Range
Dim rangeSingleCell As Range
Dim numberOfRepeats As Integer
Dim n As Integer
Dim lastRow As Long

'Set rangeInventory to all of the Inventory Data
Set rangeInventory = Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("D2").End(xlDown))

'Iterate each row of the Inventory Data
For Each rangeSingleCell In rangeInventory.Rows
    'number of times to be repeated copied from Sheet1 column 4 ("C")
    numberOfRepeats = rangeSingleCell.Cells(1, 3).Value

    'check if numberOfRepeats is greater than 0
    If numberOfRepeats > 0 Then
         With Sheets("Sheet2")
            'copy each invetory item in Sheet1 and paste "numberOfRepeat" times in Sheet2

                For n = 1 To numberOfRepeats 
                lastRow = Sheets("Sheet1").Range("A1048576").End(xlUp).Row
                r.Copy
                Sheets("Sheet1").Range("A" & lastRow + 1).PasteSpecial xlPasteValues
            Next
        End With
    End If
Next

End Sub

このソリューションは、DavidZemensソリューションのわずかに変更されたバージョンです。

1
Kiran Kodukula