有点像ExcelVBA2007中的反向轴心

我在这里和其他地方搜索并发现了许多类似的问题，但我不知道如何适应我的需要。通常我会发现pivot-like，或者我不知道如何正确地搜索和描述我需要的，或者我遗漏了一些东西

我获得了多达3万行主题/类别对的数据，并对它们进行计数/分组以获得：

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实现这一点？我试着直接从原始数据转换成这种格式，但无法理解，所以我希望这种方法能更好地工作

任何帮助都将不胜感激，即使是告诉我如何寻找更好的解决方案

---

编辑：哦，是的，每次运行这些数据时，类别列表都不一样。必须定期进行，并且会在不同时间进行更改。因此，我想知道如何在类别出现时将其从左向右扩展，然后我可以始终对其进行排序…

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

F1中的数组公式为

=IFLENE1，iFlerorIndex$B$2:$B$999，MATCH0，IFLEN$B$2:$B$999，COUNTIF$E$1:E$1，$B$2:$B$999&，1,0，，

使用Ctrl+Shift+Enter进行最终确定，然后尽可能向右填充，以便将来添加

E2中的数组公式是

=IFLENE1，iFlerorIndex$A$2:$A$999，MATCH0，IFLEN$A$2:$A$999，COUNTIF$E$1:$E1，$A$2:$A$999&，1,0，，

使用Ctrl+Shift+Enter进行最终确定，然后尽可能地填充，以便将来添加

F2中的标准公式为

=IFANDLENF$1、LEN$E2、IFERROR索引$C$2:$999、MININDEXROW$1:$998+$A$2:$A$999$E2+$B$2:$B$999F$1*1E+99、、0、，

使用Enter键完成。向右和向下填充，再加上一些额外的行/列，以便将来输入

这是我在A8:C8中键入新条目后的另一个图像

---

假设您已按主题对Sheet1进行了排序。我会为你拼几块。这是未经测试的，因为它不完整。然而，这些概念将帮助您实现您想要实现的目标

我将首先创建第二张图纸。在浏览表1时，您需要记录正在处理的行

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

在表1上建立最后一行

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

获取Sheet1上所有唯一的类别名称。您可以构建一个类别数组。分类学家

有很多关于从不同值构建数组的好信息

使用这些名称在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

一行一行地看第一页。设置一个名为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

---

数据是否已按主题排序？那分类呢？谢谢。我能够找到一种获得唯一值数组的好方法，并且能够修改/完成该数组，以满足我每次30000行的需求。谢谢很高兴听到这个消息。我希望我最初有更多的时间来包含这方面的代码。我的数据集平均大小为30000行，因此无法使用这一代码。谢谢