我在Excel中有一个数据转储，其中包含两个不同值的年度客户数据。数据单独提供了一行，用于每年和客户的价值。即它看起来像这样：

我在2009年为客户1保留了价值A的一行，为同一年同一客户为价值B保留了另一行。

在某些情况下，没有值A或值B。在上面的示例中，您可以看到客户1在2011年没有值B，因此没有为此生成任何行。而且，尽管示例中未显示，但某些客户在一年中将没有任何一个值的数据（因此该年中该客户没有行）。在这种情况下，那年在该客户那里连续缺席就可以了。

我想进入一个工作表这个地方有一排的两个每年和客户价值。即，我希望数据看起来像这样：

产生结果的最有效方法是什么？

这是VBA，或者是您可以在工作表上运行的宏。您必须打alt+调F11出Visual Basic for Application提示，转到您的工作簿right click - insert - module并将此代码粘贴到那里。然后，您可以在VBA中按来运行模块F5。此宏名为“测试”

Sub test()
'define variables
Dim RowNum as long, LastRow As long
'turn off screen updating
Application.ScreenUpdating = False
'start below titles and make full selection of data
RowNum = 2
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A2", Cells(LastRow, 4)).Select
'For loop for all rows in selection with cells
For Each Row In Selection
    With Cells
    'if customer name matches
    If Cells(RowNum, 1) = Cells(RowNum + 1, 1) Then
        'and if customer year matches
        If Cells(RowNum, 4) = Cells(RowNum + 1, 4) Then
            'move attribute 2 up next to attribute 1 and delete empty line
            Cells(RowNum + 1, 3).Copy Destination:=Cells(RowNum, 3)
            Rows(RowNum + 1).EntireRow.Delete
        End If
     End If
    End With
'increase rownum for next test
RowNum = RowNum + 1
Next Row
'turn on screen updating
Application.ScreenUpdating = True

End Sub

这将通过已排序的电子表格运行，并合并匹配客户和年份的连续行，并删除现在为空的行。电子表格必须按照您的显示方式，客户和年份的升序进行排序，该特定宏的外观不会超出连续的行。

编辑-完全有可能with statement完全不需要我，但不会伤害任何人。

修改日期：02/28/14

有人在另一个问题中使用了这个答案，当我回去时，我认为这个VBA很差。我已重做-

Sub CombineRowsRevisited()

Dim c As Range
Dim i As Integer

For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
If c = c.Offset(1) And c.Offset(,4) = c.Offset(1,4) Then
            c.Offset(,3) = c.Offset(1,3)
            c.Offset(1).EntireRow.Delete
End If

Next

End Sub

再次访问16/05/04

再次询问如何将多行中的值合并为单行？有一个模块，但是需要变量解释，这很差。

Sub CombineRowsRevisitedAgain()
    Dim myCell As Range
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row

    For Each myCell In Range(Cells("A2"), Cells(lastRow, 1))
        If (myCell = myCell.Offset(1)) And (myCell.Offset(0, 4) = myCell.Offset(1, 4)) Then
            myCell.Offset(0, 3) = myCell.Offset(1, 3)
            myCell.Offset(1).EntireRow.Delete
        End If
    Next
End Sub

但是，根据问题，将step -1行号设置为更好，这样就不会跳过任何内容。

Sub CombineRowsRevisitedStep()
    Dim currentRow As Long
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row

    For currentRow = lastRow To 2 Step -1
        If Cells(currentRow, 1) = Cells(currentRow - 1, 1) And _
        Cells(currentRow, 4) = Cells(currentRow - 1, 4) Then
            Cells(currentRow - 1, 3) = Cells(currentRow, 3)
            Rows(currentRow).EntireRow.Delete
        End If
    Next

End Sub

另外一个选项：

1. 选择B列，按CTRL+G-> Special-> Blanks->OK
2. 键入=按↑，然后CTRL+ENTER
3. 选择C列，按CTRL+G-> Special-> Blanks->OK
4. 键入=IF(按←类型=按←按↓类型,按↓类型,0)，然后CTRL+ENTER
5. 选择所有数据，Copy然后Paste Special as Values
6. 删除重复项。

编辑：

说明：我正在尝试使用GoTo Blanks选项。选择空白后，便可以为所有选定的空白单元格输入相同的公式。关于OP的问题，数据看起来像具有一致的空白，即：Value A列空白与CustomerID上面的非空白行相同。同样，Value B列空白与CustomerID下面的非空白行具有相同的含义。

最有效的方法是将所有数据转储到数据透视表中，然后将“客户”放入行标签中，然后再处理其他列。如果您想按年份查看细分，可以将“年份”拖放到列标题中

数据透视表可以在Excel 2010中的“插入”下找到

以下是使用压缩数据创建单独表的步骤。

1. 复制整个表格并将其粘贴到新的工作表上。
2. 选择新表并删除重复（数据丝带- >删除重复）的列Customer和Year。这将提供精简表的框架。

3. 在B2（的第一个条目Value A）中输入以下内容：

   =IFERROR(INDEX(Sheet1!B$1:B$11,MIN(IF(Sheet1!$A$1:$A$11=$A2,IF(Sheet1!$D$1:$D$11=$D2,IF(Sheet1!B$1:B$11<>"",ROW(Sheet1!$A$1:$A$11),1000000),1000000),1000000))),"")

   通过按Ctrl+ Shift+ 将公式输入为数组公式Enter。

4. 在列中填写公式。然后填写以填充该Value B列。瞧！

一些注意事项：

• 当然，您需要调整地址以适合您的数据。作为参考，Sheet1是A到D列中的原始数据。
• 我假设您的数据（或标题）从第1行开始。如果这是数据转储，则可能是正确的。如果不是这种情况，则必须调整公式。
• 我假设您的表少于一百万行。如果不止如此，1000000请将公式中的s 更改为大于行数的值。
• 如果您的表有数千行（100,000+），则您可能要考虑使用VBA解决方案，因为大型数组可能会使数组公式陷入困境。

每个人都为此使用了大量的VBA代码或复杂的功能。我有一个方法，要花一点时间来实现，但是它更容易理解，并且很容易根据其他各种可能性进行调整。

在上面给出的示例中，将以下（4）函数分别粘贴到单元格E2，F2，G2和H2中（上面的F＆G函数引用单元格）：

=IF(D2=D3, A2,         IF(D2<>D1, A2,            ""))    
=IF(D2=D3, MAX(B2:B3), IF(D2<>D1, B2,            ""))    
=IF(D2=D3, MAX(B2:B3), IF(D2<>D1, IF(C2=0,"",C2),""))    
=IF(D2=D3, D2,         IF(D2<>D1, D2,            ""))

将这些公式拖到尽可能远的地方。每次存在2行时，它都会生成一行数据，而单行不受影响。在其他位置特殊粘贴EFGH列的值（以删除公式），并按客户对它们进行排序以删除所有多余的行。