如何按特定列值转置 header 行值组

Question

我在 excel 中有一些数据，格式如下：

Cust_Name    Prod1     Prod2    Prod3     Prod4    Prod5
A            0         100      120       0        0
B            145       120      168       0        200
C            350       300      0        340       0

我需要将以下格式转换为below-mentioned报告格式。

我想通过 Cust_Name 转置列组中的那些产品，其值 >0 否则它不应成为最终输出报告的一部分。

我尝试了很多枢轴选项，但都没有用。

所需输出：

Cust_Name      Product       Price
A              Prod2         100
               Prod3         120
Total A        -             220
B              Prod1         145
               Prod2         120
               Prod3         168
               Prod5         200
Total B        -             633
C              Prod1         350
               Prod2         300
               Prod4         340
Total C        -             890

Answer 1

您可以使用 PowerQuery 执行此操作。

Select 源数据中的任何单元格。使用数据>获取并转换数据>来自 Table/Range.

PowerQuery 编辑器将打开，如下所示：

Select Cust_Name 列通过单击 header 列。使用转换>逆透视列>逆透视其他列：

此时，可选择过滤“值”列以排除 0。

现在使用“开始”>“关闭并加载”将数据放回您的工作簿。

您现在可以创建数据透视表 table 来获取小计：

这是 PowerQuery 编辑器中“高级编辑器”对话框的查询：

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Cust_Name", type text}, {"Prod1", Int64.Type}, {"Prod2", Int64.Type}, {"Prod3", Int64.Type}, {"Prod4", Int64.Type}, {"Prod5", Int64.Type}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Cust_Name"}, "Attribute", "Value")
in
    #"Unpivoted Other Columns"

Answer 2

如果您需要VBA解决方案，请测试下一个代码。它会在另一个sheet中return处理结果。它旨在处理 sheet（在 headers 行）中的产品数量。代码应该非常快，所有处理都在内存中完成：

Sub TransposeSummarize()
  Dim sh As Worksheet, shRet As Worksheet, lastR As Long, lastCol As Long, dict As Object
  Dim arr, arrFin, arrDict, i As Long, J As Long, k As Long, count As Long
  
  Set sh = ActiveSheet
  Set shRet = sh.Next 'use here the sheet you need returning
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row          'last row
  lastCol = sh.cells(1, sh.Columns.count).End(xlToLeft).Column 'last column
  arr = sh.Range("A1", sh.cells(lastR, lastCol)).Value 'place the range in an array for faster iteration
  ReDim arrDict(UBound(arr, 2) - 2)                    'Redim the arrDict for first time
  Set dict = CreateObject("Scripting.Dictionary")      'set the Dictionary (Scripting) object
  For i = 2 To UBound(arr)                             'iterate between the array elements (rows and columns)
        For J = 2 To UBound(arr, 2)
            arrDict(J - 2) = arr(i, J)                 'fill arrDict with values on the i row
        Next J
        dict(arr(i, 1)) = arrDict                      'place the array as dictionary item
        Erase arrDict: ReDim arrDict(UBound(arr, 2) - 2) 'reinitialize the necessary array
  Next i

  ReDim arrFin(1 To dict.count * lastCol + 1, 1 To 3): k = 1
  'Put the Headers in the final array:
  arrFin(1, 1) = "Cust_Name": arrFin(1, 2) = "Product": arrFin(1, 3) = "Price": k = 2
  
  For i = 0 To dict.count - 1             'process the dictionary keys/items and create the final array
        arrFin(k, 1) = dict.Keys()(i)
        For J = 0 To UBound(dict.Items()(i))
            If dict.Items()(i)(J) <> 0 Then
                arrFin(k, 2) = arr(1, J + 2): arrFin(k, 3) = dict.Items()(i)(J)
                count = count + dict.Items()(i)(J): k = k + 1
            End If
        Next J
        arrFin(k, 1) = "Total " & dict.Keys()(i): arrFin(k, 2) = "-": arrFin(k, 3) = count
        count = 0: k = k + 1
  Next i
  'drop the array content at once, at the end of the code:
  shRet.Range("A1").resize(k - 1, UBound(arrFin, 2)).Value = arrFin
End Sub

已编辑:

我把上面的代码复杂化了，只是因为我在收到关于唯一“cust_names”的答案之前就开始处理它了。我打算使用字典来处理多个这样的名字。下一个版本，不再使用字典，提取最后的数组内容只处理第一个。只是玩 VBA:

Sub TransposeSummarizeUnique()
  Dim sh As Worksheet, shRet As Worksheet, lastR As Long, lastCol As Long
  Dim arr, arrFin, i As Long, J As Long, k As Long, count As Long
  
  Set sh = ActiveSheet
  Set shRet = sh.Next 'use here the sheet you need returning
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row           'last row
  lastCol = sh.cells(1, sh.Columns.count).End(xlToLeft).Column 'last column
  arr = sh.Range("A1", sh.cells(lastR, lastCol)).Value 'place the range in an array for faster iteration
  ReDim arrFin(1 To UBound(arr) * lastCol + 1, 1 To 3)
  
  'Put the Headers in the final array:
  arrFin(1, 1) = "Cust_Name": arrFin(1, 2) = "Product": arrFin(1, 3) = "Price": k = 2

  For i = 2 To UBound(arr)                            'iterate between the array rows:
        arrFin(k, 1) = arr(i, 1)                      'fill the customer name
        For J = 2 To UBound(arr, 2)                   'iterate beteen the array columns"
            If arr(i, J) <> 0 Then
                arrFin(k, 2) = arr(1, J): arrFin(k, 3) = arr(i, J)'fill the product and its value
                count = count + arr(i, J): k = k + 1   'calculate the values sum
            End If
        Next J
        'write the balance row (Total, Sum):
        arrFin(k, 1) = "Total " & arr(i, 1): arrFin(k, 2) = "-": arrFin(k, 3) = count
        count = 0: k = k + 1                           'reinitialize the count and increment the array row
  Next i

  'drop the array content at once, at the end of the code:
  shRet.Range("A1").resize(k - 1, UBound(arrFin, 2)).Value = arrFin
End Sub

如何按特定列值转置 header 行值组

How to Transpose header row value group by particular column value

excel

vba

unpivot

excel-formula

powerquery