0

私は本当に答えを一生懸命探していましたが、まだ見つけられません。助けてください！

VBA または SQL を使用して Access で操作したい Excel のワークブックがあります。

私が直面している現在の問題は、各行が 1 つの請求書 (2500 行) に基づいているスプレッドシートを持っていることです。各行は、「請求書番号」「発注番号」「請求日」「請求合計」で構成されています。これを請求書データと呼ぶことができます

次に、その行には、品目情報、「品目番号」、「品目原価」、「品目数量」に基づくセルがあります。ラインアイテムデータ

また、明細データは、対象となる請求書の各明細が繰り返されるまで繰り返されます (つまり、70 の明細がある場合、70 の異なる明細データと多数の列が存在することになります)。

各行が請求書情報の代わりに明細情報に基づいているようにする方法が必要ですが、各行にはそれぞれの請求書情報が保持されています (「請求書番号」「PO 番号」「請求日」「請求書合計」 」）。

また、コードは、行 1 の項目データをコピーしてから行 2 の項目データをコピーするように指示する必要がないように、十分に単純である必要があります。(おそらく、3 列ごとに新しいアイテムであり、その行に請求書情報が含まれていることを理解できます)。行 30 に 50 の項目がある可能性があるため、行 1 に空白の列がある場合も停止できません (請求書 1 には 3 つの項目があり、請求書 30 には 50 の項目がありました)。

私は答えを見つけるために探し続けます。もし見つけたら、ここに投稿します..事前にご協力いただきありがとうございます！

4

1 に答える 1

1 
Sub UnPivot()

Const INV_COLS As Integer = 4   'how many columns in the invoice info
Const ITEM_COLS As Integer = 3  'columns in each set of line item info

Dim shtIn As Worksheet, shtOut As Worksheet
Dim c As Range
Dim rOut As Long, col As Long


    Set shtIn = ThisWorkbook.Sheets("Data")
    Set shtOut = ThisWorkbook.Sheets("Output")

    Set c = shtIn.Range("A2") 'first cell in invoice info
    rOut = 2                  'start row on output sheet

    'while the invoice cell is non-blank...
    Do While Len(c.Value) > 0
        col = INV_COLS + 1   'column for first line item
        'while there's info in the line item cell 
        Do While Application.CountA(shtIn.Cells(c.Row, col).Resize(1, ITEM_COLS)) > 0

            'copy the invoice info (four cells)
            c.Resize(1, INV_COLS).Copy shtOut.Cells(rOut, 1)

            'copy the line item info (3 cells)
            shtIn.Cells(c.Row, col).Resize(1, ITEM_COLS).Copy _
                             shtOut.Cells(rOut, INV_COLS + 1)

            rOut = rOut + 1           'next output row
            col = col + ITEM_COLS     'move over to next line item
        Loop
        Set c = c.Offset(1, 0) 'move down one cell on input sheet
    Loop

    shtOut.Activate
End Sub
于 2012-08-02T20:40:03.067 に答える