Question

我搜索并发现了许多类似的问题（这里和其他地方），但我无法理解如何适应我的需求。通常我找到像Pivot data using VBA这样的枢轴，要么我无法弄清楚如何正确地搜索（描述）我需要的东西，或者我错过了什么。

我获取主题/类别对的数据（最多30K行）并对它们进行计数/分组以获得：

Subject  Category   Count
  A         C1         1
  A         C2         4
  B         C1         8
  B         C2         1
  B         C3         2
  C         C2         4

我需要将数据显示为

Subject     C1     C2     C3
  A          1      4      0
  B          8      1      2
  C          0      4      0

有没有办法使用Excel VBA实现这一目标？我尝试从原始数据直接使用这种格式，但无法弄清楚，所以希望这种方式更好。

任何帮助都会受到极大的赞赏 - 即使是告诉我如何更好地寻找解决方案。

编辑：哦是的，每次运行此数据时，类别列表都不相同。必须定期完成，并将从一次变为下一次。所以我想弄清楚如何将类别从左到右展开（然后我可以随后对它们进行排序）......

Answer 1

此标准/数组公式解决方案是否适用于您的情况取决于您要查看的值的数量。随着数据表的增长，数组公式会以对数方式占用CPU周期。

[Unique Transposed Data

F1中的数组公式为

=IF(LEN(E1), IFERROR(INDEX($B$2:$B$999,MATCH(0, IF(LEN($B$2:$B$999), COUNTIF($E$1:E$1,$B$2:$B$999&""),1),0)),""),"")

使用 Ctrl + Shift + 输入进行最终确定，然后根据需要填写，以便将来添加。

E2中的数组公式是

=IF(LEN(E1), IFERROR(INDEX($A$2:$A$999,MATCH(0, IF(LEN($A$2:$A$999), COUNTIF($E$1:$E1,$A$2:$A$999&""),1),0)),""),"")

使用 Ctrl + Shift + 输入进行最终确定，然后根据需要填写，以便将来添加。

F2中的标准formulka 是

=IF(AND(LEN(F$1),LEN($E2)),IFERROR(INDEX($C$2:$C$999, MIN(INDEX(ROW($1:$998)+(($A$2:$A$999<>$E2)+($B$2:$B$999<>F$1))*1E+99,,))),0),"")

使用输入进行最终确定。向右和向下填充（加上一些额外的行/列以备将来输入）。

这是我在A8中输入新条目后的另一张图片：C8。

[Unique Transposed Data 2

Answer 2

假设您按主题对Sheet1进行了排序。我会为你准备一些碎片。这是未经测试的，因为它不完整。但是，这些概念将为您提供您想要完成的任务。

我首先要创建第二张表。在浏览Sheet1时，您需要跟踪正在处理的行。

Dim tRow As Long   'tRow to represent the target row, one for each subject on Sheet1
tRow = 1           'Start on row 1, the code below takes into account the header row

在Sheet1上建立lastRow。

lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

获取Sheet1上的所有唯一类别名称。您可以构建一个类别数组。 “所属分类（）”

This LINK to Chip Pearson's page有很多关于从不同值构建数组的好信息。

使用这些名称在Sheet2上构建列标题。执行循环

For c = 0 To UBound(categoryList)
    Sheets("Sheet2").Cells(1, c + 2) = categoryList(c)   'c+2 because column 2 is the first Category
Next c

逐行，浏览Sheet1。设置名为“lastSubject”的变量，并将该行的A列中的值与lastSubject进行比较。

Dim lastSubject As String
lastSubject = ""
For r = 2 To lastRow
    If Sheets("Sheet1").Cells(r, 1) <> lastSubject Then
        lastSubject = Sheets("Sheet1").Cells(r, 1)  
        tRow = tRow + 1     'Add 1 to target row on Sheet2, because the subject changed.
        Sheets("Sheet2").Cells(tRow, 1) = Sheets("Sheet1").Cells(r, 1)   'Set the Subject on Sheet2
    End If

    For c = 0 to UBound(categoryList)
        If Sheets("Sheet1").Cells(r, 2).Value = categoryList(c) Then
            Sheets("Sheet2").Cells(tRow, c + 2) = Sheets("Sheet1").Cells(r, 3)  'Set the Count
        End If
    next c       
next r

有点像Excel VBA 2007中的反向轴

2 个答案: