各位打扰，数据处理或者数据透视能完成这个效果吗？分类统计

lee时光

原始表格如下：

想将各公司的各等级产品放在一起，整理后的如下这种效果：

数据透视不行，尝试用query提示被枚举中用于完成的数据过多
各位大佬，有什么方法可以完成这个效果呢？

misterZ

数据透视表和pq都可以   但是你没有附件  就算了

ykcbf1100

上个附件吧，解决起来应该不难。
附件要压缩后才能上传。

cnmlgb9998

PQ ！！！！！！！！！！！！！！！！！！

gwjkkkkk

数组+字典能完成.

fzxba

Sub test1()
  
  Dim data, result() As String, Dict As Object
  Dim i As Long, strKey As String
  Dim posRow As Long, rowSize As Long, posCol As Long, colSize As Long
  
  Set Dict = CreateObject("Scripting.Dictionary")
  data = Range("A1").CurrentRegion
  ReDim result(1 To UBound(data), 1 To UBound(data))
  
  rowSize = 1
  colSize = 1
  result(rowSize, colSize) = data(rowSize, colSize)
  
  For i = 2 To UBound(data)
   
    strKey = data(i, 1)
    If Not Dict.Exists(strKey) Then
      rowSize = rowSize + 1
      result(rowSize, 1) = strKey
      Dict.Add strKey, rowSize
    End If
    posRow = Dict(strKey)
   
    strKey = data(i, 3)
    If Not Dict.Exists(strKey) Then
      colSize = colSize + 1
      result(1, colSize) = strKey
      Dict.Add strKey, colSize
    End If
    posCol = Dict(strKey)
   
    If Len(result(posRow, posCol)) Then
      result(posRow, posCol) = result(posRow, posCol) & vbCrLf & data(i, 2)
    Else
      result(posRow, posCol) = data(i, 2)
    End If
  Next
  
  With Range("K1")
    .CurrentRegion.Clear
    With .Resize(rowSize, colSize)
      .Borders.LineStyle = xlContinuous
      .HorizontalAlignment = xlCenter
      .Rows(1).Font.Bold = True
      .Value = result
    End With
  End With
  
  Set Dict = Nothing
  Beep
End Sub

lee时光

cnmlgb9998 发表于 2024-3-8 17:53
PQ ！！！！！！！！！！！！！！！！！！

大佬，按照您的方法，提示Expression.Error: 11 参数传递到了一个函数，该函数应介于 3 和 4 之间。
详细信息:
    Pattern=
    Arguments=[List]
是什么原因呢？辛苦您了

cnmlgb9998

lee时光 发表于 2024-3-8 21:36
大佬，按照您的方法，提示Expression.Error: 11 参数传递到了一个函数，该函数应介于 3 和 4 之间。
详 ...

我这没问题。应该是你那边，会不会PQ ？？？？

lee时光

cnmlgb9998 发表于 2024-3-8 21:37
我这没问题。应该是你那边，会不会PQ ？？？？

您方便发一下您的这个文件嘛，谢谢您

cnmlgb9998

！！！！！！！！！！！！！！！！！！！