Question

我真的很难找到答案而仍然找不到答案。请帮忙！

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

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

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

行项目数据一直重复，直到发票中的每个行项目都被覆盖（即如果有70个行项目，则会有70个不同的行项目数据和一串列的数据）

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

此外，代码需要足够简单，我不需要告诉它复制第1行项目数据然后第2行项目数据等，直到第70行数据。（也许它可以理解每3列是一个新项目，它所在的行有它的发票信息）。当第1行有空白列时它也无法停止，因为第30行可能有50个项目。（发票1有3个订单项，发票30有50个订单项）

我会继续寻找答案，如果我找到答案，我会在这里张贴。感谢您的帮助！

Answer 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

在SQL中分别将列转换为行

1 个答案: