这里有一个方法。结果放在一个单独的表中。

Sub test()
    Dim wsResult As Worksheet
    Dim rng As Range, arr, r As Long, c As Long, mR, mC
    
    Set wsResult = ThisWorkbook.Worksheets("Result")          'sheet for result
    wsResult.Cells.ClearContents
    
    Set rng = ThisWorkbook.Worksheets("Data").Range("B4:I12") 'source data
    arr = rng.Value
    
    For r = 2 To UBound(arr, 1)        'loop input rows from row 2
        mR = Application.Match(arr(r, 1), wsResult.Columns(1), 0) 'already have row header?
        If IsError(mR) Then 'if no mtch found...
            mR = wsResult.Cells(Rows.Count, 1).End(xlUp).row + 1 'next empty cell in column A
            wsResult.Cells(mR, 1).Value = arr(r, 1)              'add the row header
        End If
        For c = 2 To UBound(arr, 2)   'loop input columns
            mC = Application.Match(arr(1, c), wsResult.Rows(1), 0) 'follow same process as for row headers
            If IsError(mC) Then
                mC = wsResult.Cells(1, Columns.Count).End(xlToLeft).Column + 1
                wsResult.Cells(1, mC).Value = arr(1, c)
            End If
            With wsResult.Cells(mR, mC)
                .Value = .Value + 1  'increment the count for this unique pair of row/column label
            End With
        Next c
    Next r
End Sub

字符串

您可以使用data. from table/range [ ] header将范围带入PowerQuery
x1c 0d1x的数据
进入主页...高级编辑器...然后从下面粘贴。使用自动生成的第一行代替我的行来保留您的范围名称

let Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content], //use your auto generated first row in place of this one
#"Promoted Headers" = Table.PromoteHeaders(Source, [PromoteAllScalars=true]),
#"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Promoted Headers", {"Column1"}, "Attribute", "Value"),
Split_Dupes = Table.TransformColumns(#"Unpivoted Other Columns",{{"Attribute", each Text.BeforeDelimiter(_,"_"), type text}}),
#"Pivoted Column" = Table.Pivot(Split_Dupes, List.Distinct(Split_Dupes[Attribute]), "Attribute", "Value", List.Sum)
in #"Pivoted Column"

字符串
文件.关闭并加载.表格回Excel
右键单击并在需要时刷新表，或重新刷新powerquery

的