0

我真的一直在努力寻找答案，但仍然找不到。请帮忙！

我有一个 Excel 工作簿，我想使用 VBA 或 SQL 在 Access 中进行操作。

我目前面临的问题是我有一个电子表格，其中每一行都基于一张发票（2500 行）。每行由“发票编号”“采购订单编号”“发票日期”“发票总计”组成。我们可以称之为发票数据

然后在该行中有基于行项目信息的单元格，“项目编号”“项目成本”“项目数量”。行项目数据

并且行项目数据重复，直到涵盖发票中的每个行项目（即，如果有 70 个行项目，将有 70 个不同的行项目数据和一堆列）

我需要一种方法来使每一行都基于行项目信息，而不是发票信息，而每一行仍保留项目各自的发票信息（“发票编号”“采购订单编号”“发票日期”“发票总计”）。

此外，代码需要足够简单，以至于我不需要告诉它复制第 1 行项目数据然后第 2 行项目数据等，直到第 70 行数据。（也许它可以理解每 3 列是一个新项目，并且它所在的行具有它将采用的发票信息）。当第 1 行有空白列时，它也不能停止，因为第 30 行可能有 50 个项目。（发票 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 回答