Question

想知道是否有人可以指出我正确的方向。我有一个200,000 +行的电子表格示例如下。（部件号是字母数字）

Part Number       Areacode          Description
1                 1                 Table
2                 1                 Chair
3                 1                 Bookcase
7                 1                 Bookcase
4                 2                 Table
5                 2                 Shelf
6                 3                 Chair
8                 3                 Chair

我正在努力实现这个目标

Area Code         Table            Chair            Bookcase            Shelf
1                 1                2                3,7
2                 4                                                     5
3                                  3,8

我认为数据透视表可能是理想的解决方案，但我尝试了这一点，不幸的是我无法看到可以将实际文本值添加到总和区域。我猜测前进的唯一方法是某种宏？

2个月后，如果有人有任何想法，仍然需要帮助这些人

Answer 1

我已完成任务，但我相信可能有更快的方法来实现这一目标。解决方案是从https://www.ablebits.com/

下载Ablebits Combine Rows程序

这允许我根据区号连接部件号，所以在我的主表中我现在有区号3.部件号= 3,8和描述=椅子

然后我插入了一个新列，并为所有内容提供了唯一的数字标识符。

之后我运行了一个数据透视表，将区号作为垂直值，描述为水平值，在计算字段中将其设置为新的唯一标识符字段，并设置为min。最大或产品。

然后我将数据透视表复制并粘贴到一个新工作表中，并对每个唯一标识符进行查找，以获得实际的部件编号作为文本值 - 这是耗时的一点，因为需要70个VLookups。

我仍然有兴趣听到任何更快的方法。

感谢。

Answer 2

Sub Tester()
    Dim rngIn, rngOut

    Set rngIn = Sheets("Data")
    Set rngOut = Sheets("Pivoted")

    rngOut.CurrentRegion.ClearContents

    PivotRange rngIn, 2, 3, 1, rngOut
End Sub


Function PivotRange(rngIn, rowCol, catCol, valCol, rngOut)
    Dim dictRows, dictCols, r, nR, nC, arr, kR, kC

    Set dictRows = CreateObject("scripting.dictionary")
    Set dictCols = CreateObject("scripting.dictionary")

    arr = rngIn.Value

    Application.ScreenUpdating = False
    rngOut.Value = arr(1, rowCol) 'row header

    For r = 2 To UBound(arr, 1) 'skip column headers
        kR = arr(r, rowCol)
        kC = arr(r, catCol)
        If Not dictRows.exists(kR) Then
            nR = nR + 1
            dictRows.Add kR, nR
            rngOut.Offset(nR, 0).Value = kR
        End If
        If Not dictCols.exists(kC) Then
            nC = nC + 1
            dictCols.Add kC, nC
            rngOut.Offset(0, nC).Value = kC
        End If
        With rngOut.Offset(dictRows(kR), dictCols(kC))
            .Value = .Value & IIf(.Value <> "", ",", "") & arr(r, valCol)
        End With
    Next r

End Function

Excel数据摘要按文本值 - 与数据透视表类似

2 个答案: