2

次のデータを含む

col1      col2    col3    col4
dvdtable    6      52      57
tvunit      2      30      31

各行を別のシートにコピーする必要がありますが、dvdtable 行の 6 つのコピーと tvunit 行の 2 つのコピーを作成します。（col2は数量を指しています）。さらに、6 つの dvdtable 行のそれぞれについて、新しい列にそれぞれ 52、53、54、55、56、57 を含める新しい列を作成する必要があります。以下の結果を参照してください。

col1      col2    col3 
dvdtable    6      52
dvdtable    6      53
dvdtable    6      54
dvdtable    6      55
dvdtable    6      56
dvdtable    6      57
tvunit      2      30
tvunit      2      31

フォーラムの別の質問のおかげで、行の複数のコピーを作成するコードを作成できましたが、プログラミングの最後の部分で立ち往生しています。ここでは、列 3 と列で指定された範囲内の数値のリストを作成する必要があります。家具の種類ごとに4つ。

4

2 に答える 2

2

シート名を変更する必要がある可能性があります。

Option Explicit
Sub whyDidIDoThisForYou()

    Dim i, j, k As Integer
    Dim numbRows As Integer
    Dim curWriteRow As Integer
    Dim temp As Integer
    Dim values() As String

    numbRows = Range("a1").End(xlDown).Row - 1 'assumes heading
    curWriteRow = 1
    ReDim values(1 To numbRows, 1 To 4)

    For i = 1 To numbRows

        'read all values in from initial datasheet
        For j = 1 To 4
            values(numbRows, j) = Sheets("Sheet1").Cells(i + 1, j).Value
        Next j

        'write to next sheet
        'get number of things to write
        temp = values(numbRows, 4) - values(numbRows, 3)

        'start writing the "output" sheet!
        For j = 0 To temp
               Sheets("Sheet2").Cells(curWriteRow, 1).Value = values(numbRows, 1)
               Sheets("Sheet2").Cells(curWriteRow, 2).Value = values(numbRows, 2)
               Sheets("Sheet2").Cells(curWriteRow, 3).Value = values(numbRows, 3) + j
               curWriteRow = curWriteRow + 1
        Next j

    Next i

End Sub
于 2012-09-11T17:07:53.760 に答える
0

以下のように配列を使用できます。これは、セルごとに範囲に書き込むよりもはるかに高速です。

以下のコード

  • 元のデータをバリアント配列に読み込みますY
  • Y （lngCnt2）の各行をループします
  • YcolulmBで特定の回数だけそれを実行します（ lngCnt3）
  • 新しいレコードを2番目のバリアント配列にダンプしますX
  • 終了時にx開始する範囲にダンプしますE1

ここに画像の説明を入力してください

Sub SplicenDice()
Dim rng1 As Range
Dim lngCnt As Long
Dim lngCnt2 As Long
Dim lngCnt3 As Long
Dim lngCnt4 As Long
Dim X
Dim Y
Set rng1 = Range([a1], Cells(Rows.Count, "D").End(xlUp))
Y = rng1.Value2
lngCnt = Application.WorksheetFunction.Sum(Range("B:B"))
ReDim X(1 To lngCnt, 1 To 3)
For lngCnt2 = 1 To UBound(Y, 1)
For lngCnt3 = 1 To Y(lngCnt2, 2)
lngCnt4 = lngCnt4 + 1
X(lngCnt4, 1) = Y(lngCnt2, 1)
X(lngCnt4, 2) = Y(lngCnt2, 2)
X(lngCnt4, 3) = Y(lngCnt2, 3) + lngCnt3 - 1
Next
Next
[e1].Resize(UBound(X, 1), UBound(X, 2)).Value2 = X
End Sub
于 2012-09-12T00:01:28.567 に答える