重叠索引/重复性词汇的Excel数据凝聚

我有一个Excel格式的格式如下：

我想将其格式化为如下所示：

它大约有4万个信息单元，那么有没有办法做到这一点，而不是手动？

Answer 1

您可能可以使用= SUMIF来实现这一点，因为您似乎有数字作为值。 创build一个新工作表，从数据表复制列A到新工作表并删除重复项。 将数据表中的第1行复制到新工作表。 在工作表2单元格B2中使用此公式：

=SUMIF(Sheet1!$A:$A;Sheet2!$A2;Sheet1!B:B) 

将公式拖到右侧，然后向下拖动。

Answer 2

我不是一个擅长的专家，这将是我的第一个答案。 请考虑到这一点。

我已经检查过它，它的工作原理。 我在Sheet1中添加了一个命令button（原始数据在这里），当点击这个代码时，将格式化的数据写入到Sheet2中。

无需手动删除重复！

 Dim dU1 As Object, cU1 As Variant, iU1 As Long, lrU As Long Dim MyArray() As Variant Dim i As Integer Dim j As Integer Dim k As Integer Dim h As Integer Private Sub CommandButton1_Click() 'Get unique indexes Set dU1 = CreateObject("Scripting.Dictionary") lrU = Cells(Rows.Count, 1).End(xlUp).Row 'number of rows cU1 = Range("A2:A" & lrU) 'Assuming your data starts in A2 For iU1 = 1 To UBound(cU1, 1) dU1(cU1(iU1, 1)) = 1 Next iU1 'Now dU1 contains indexes as unique values (about, absence, etc.) For i = 0 To dU1.Count - 1 'for each index ReDim MyArray(1 To 1) As Variant 'starts a "new" array For j = 2 To 9 'each of the columns with values (D1-D8) a = 0 For k = 2 To lrU 'all rows If (Worksheets("Sheet1").Cells(k, 1).Value = dU1.keys()(i) And Worksheets("Sheet1").Cells(k, j).Value <> "") Then MyArray(UBound(MyArray)) = Worksheets("Sheet1").Cells(k, j).Value 'add value to array ReDim Preserve MyArray(1 To UBound(MyArray) + 1) As Variant 'resize array (now is 1 element longer) a = a + 1 End If Next If a = 0 Then 'if no value found, add an element to array anyway MyArray(UBound(MyArray)) = "" 'add value to array ReDim Preserve MyArray(1 To UBound(MyArray) + 1) As Variant 'resize array (now is 1 element longer) End If Next Worksheets("Sheet2").Cells(i + 2, 1) = dU1.keys()(i) 'write indexes in another sheet For h = 2 To UBound(MyArray) Worksheets("Sheet2").Cells(i + 2, h) = MyArray(h - 1) Next Next End Sub