Excelセル値に基づいて複数の値を繰り返す方法X Times

Question

誰にでも助けることができます...事前に感謝します。項目番号の

各行、パック、及びサイズカラム「ラベル数」の個数に基づいて別々のシートに複数回繰り返される

を必要としている（注意してください：の数字をラベルの数は、テスト目的のためであり、をインクリメントする必要がない）

Item # Pack Size Number of Labels 
12545 20  1.8oz 1 
56010 6  4PK  2 
70091 6  7oz  3 
61816 24  1.6oz 4 

を次のように

シート1は次のようになり

私は次のような出力にシート2のようになる：

Item # Pack Size 
12545 20  1.8oz 
56010 6  4PK 
56010 6  4PK 
70091 6  7oz 
70091 6  7oz 
70091 6  7oz 
61816 24  1.6oz 
61816 24  1.6oz 
61816 24  1.6oz 
61816 24  1.6oz 

私は、次のコードを見つけたが、私はセル入力が固定されるように範囲をしたいとダイアログboxesIを使用しないように私が持っているコードを変更する助けが必要私の与えられた問題に取り組むために見つけました。複数のcolomnsを出力するには、次のコードが必要です。 ：

Sub CopyData() 
'Update 20140724 
Dim Rng As Range 
Dim InputRng As Range, OutRng As Range 
xTitleId = "KutoolsforExcel" 
Set InputRng = Application.Selection 
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8) 
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8) 
Set OutRng = OutRng.Range("A1") 
For Each Rng In InputRng.Rows 
    xValue = Rng.Range("A1").Value 
    xNum = Rng.Range("B1").Value 
    OutRng.Resize(xNum, 1).Value = xValue 
    Set OutRng = OutRng.Offset(xNum, 0) 
Next 
End Sub 

私は素晴らしいことだ任意の助けを働いていないんしようとしていハッキング： （https://www.extendoffice.com/documents/excel/1897-excel-repeat-cell-value-x-times.html#a2私はここにコードを得ました）。

コンテキスト：新製品のために自分の仕事で多くのラベルを作成する必要があります。 Wordで各ラベルを手動で入力する必要があります。私は、単語の差し込み印刷操作を使用してExcelデータをインポートできることを発見しました。私はこれらの部品を使用していますが、今はそれぞれのアイテムに必要なラベルの正確な数を取得する必要があります。

Answer 1

Private Sub hereyago() 

    Dim arr As Variant 
    Dim wsO As Worksheet 
    Dim this As Integer 

    arr = ThisWorkbook.Sheets("Sheet1").UsedRange 
    Set wsO = ThisWorkbook.Sheets("Sheet2") 

    For i = LBound(arr, 1) To UBound(arr, 1) 
     If IsNumeric(arr(i, 4)) Then 
      this = arr(i, 4) 
      For h = 1 To this 
       wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(1, 0).Value = arr(i, 1) 
       wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 1).Value = arr(i, 2) 
       wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 2).Value = arr(i, 3) 
       wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 3).Value = arr(i, 4) 
      Next h 
     End If 
    Next i 
End Sub