Excel 或 Access：如何对表中的几行进行分组并在列中插入内容？（“拆分列”）

Question

我有一张包含所售产品数据的表格（如左侧的示例所示）：

列：
订单编号
产品名称
属性 - 指定以下字段“值”中给出的内容，例如客户名称或产品变体
值 - 是属性计数的值
- 是订单中销售的此变体产品的数量

这意味着：产品 B 有 2 个变体“c”和“d” 请注意，在订单 1 中，产品 B 仅在变体 d 中出售，因为字段“D4”中的字母“N”表示“无”。请注意，在订单号 3 中，产品 B 仅在变体 c 中出售，因为对于变体 d，字段“D9”为“N”！！ 这很令人困惑，但这是原始数据的结构（我无法改变）。

我需要一种方法将左边的表格转换为右边的表格：

• 每个产品类型占一行
• 订单号
• 产品名称
• 顾客姓名
• 数量（此订单中销售的产品数量）
• 变体- 这就是问题所在，因为它必须用

因此，具有相同 OrderNo 和相同产品的所有行必须分组为一个，并且

我希望我的需求已经很明确了。我尝试使用数据透视表来实现，但失败了，因为无论其值是否为“N”，计数始终都在每一行中，并且对于没有变体的产品，每个订单只有一行，但是对于有变体的产品，则有几行...

那么，我如何使用 MS Excel 中的 VBA 宏创建正确的表格，或者 MS Access 中是否有技巧可以直接或使用 SQL 查询来执行此操作？

Answer 1

这很令人困惑，但我明白了。将代码粘贴到模块中。确保您在主表上进行评估并运行transformTable()。

它的工作原理大致如下：

• 浏览列表
• 忽略值列中包含 N 的任何行
• 创建订单集合
• 如果订单已经存在（基于订单号、产品和数量），则向其中添加信息（如客户或变体信息）
• 然后循环遍历订单集合并将其打印到新表上

希望你喜欢。

Option Explicit

Public Type OrderInfo
    orderNo As Long
    product As String
    customer As String
    productVariant As String
    producctVariantName As String
    productCount As Long
End Type

Public Sub transformTable()
    Dim sh As Excel.Worksheet
    Dim orders() As OrderInfo

    Set sh = ActiveSheet
    orders = buildOrders(sh)
    Call createNewTable(orders)
End Sub

Private Sub createNewTable(ByRef orders() As OrderInfo)
    Application.ScreenUpdating = False

    Dim wb As Excel.Workbook
    Dim newSh As Excel.Worksheet
    Dim i As Long
    Dim curRow As Long

    curRow = 2
    Set wb = ThisWorkbook
    Set newSh = wb.Worksheets.Add

    newSh.Range("A1:F1").Value = Array("OrderNo", "Product", "Cust", "Count", "Variant", "Variant Name")

    For i = LBound(orders) To UBound(orders)
        newSh.Cells(curRow, "A").Value = orders(i).orderNo
        newSh.Cells(curRow, "B").Value = orders(i).product
        newSh.Cells(curRow, "C").Value = orders(i).customer
        newSh.Cells(curRow, "D").Value = orders(i).productCount
        newSh.Cells(curRow, "E").Value = orders(i).productVariant
        newSh.Cells(curRow, "F").Value = orders(i).producctVariantName

        curRow = curRow + 1
    Next i
    Application.ScreenUpdating = True
End Sub

Private Function buildOrders(ByRef sh As Excel.Worksheet) As OrderInfo()
    Dim lastRow As Long
    Dim i As Long
    Dim index As Long
    Dim indexFound As Long
    Dim orders() As OrderInfo

    lastRow = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
    ReDim orders(0)

    If (lastRow <= 1) Then
        buildOrders = orders
        Exit Function
    End If

    For i = 2 To lastRow
        If (sh.Cells(i, "D").Value <> "N") Then
            indexFound = findIndex(orders, sh.Cells(i, "A").Value, sh.Cells(i, "B").Value, sh.Cells(i, "E").Value)

            If (indexFound = -1) Then
                ' add new orderInfo
                ReDim Preserve orders(index)
                If (sh.Cells(i, "C").Value = "Cust") Then
                    orders(index) = createOrderInfo(sh.Cells(i, "A").Value _
                                            , sh.Cells(i, "B").Value _
                                            , sh.Cells(i, "E").Value _
                                            , sh.Cells(i, "D").Value)
                ElseIf (InStr(1, sh.Cells(i, "C").Value, "Variant", vbTextCompare) > 0) Then
                    orders(index) = createOrderInfo(sh.Cells(i, "A").Value _
                                            , sh.Cells(i, "B").Value _
                                            , sh.Cells(i, "E").Value _
                                            , productVariant:=Right(sh.Cells(i, "C").Value, 1) _
                                            , productVariantName:=sh.Cells(i, "D").Value)
                End If
                index = index + 1
            Else
                ' add customer or variant
                If (sh.Cells(i, "C").Value = "Cust") Then
                    orders(indexFound).customer = sh.Cells(i, "D").Value
                ElseIf (InStr(1, sh.Cells(i, "C").Value, "Variant", vbTextCompare) > 0) Then
                    orders(indexFound).productVariant = Right(sh.Cells(i, "C").Value, 1)
                    orders(indexFound).producctVariantName = sh.Cells(i, "D").Value
                End If
            End If

        End If

    Next i

    buildOrders = orders
End Function


Private Function createOrderInfo(ByVal orderNo As Long _
                                , ByRef product As String _
                                , ByVal productCount As Long _
                                , Optional ByRef customer As String = "" _
                                , Optional ByRef productVariant As String = "" _
                                , Optional ByRef productVariantName As String = "") As OrderInfo

    Dim oi As OrderInfo
    oi.orderNo = orderNo
    oi.product = product
    oi.productCount = productCount
    oi.customer = customer
    oi.productVariant = productVariant
    oi.producctVariantName = productVariantName

    createOrderInfo = oi
End Function



Private Function findIndex(ByRef orders() As OrderInfo _
                            , ByVal orderNo As Long _
                            , ByRef product As String _
                            , ByVal productCount As Long) As Long
    Dim i As Long

    For i = LBound(orders) To UBound(orders)
        If (orders(i).orderNo = orderNo And orders(i).product = product And orders(i).productCount = productCount) Then
            findIndex = i
            Exit Function
        End If
    Next i

    findIndex = -1
End Function