Question

我在Excel中有大量数据如下所示：

Address Bins address1 94 Gallon address1 60 Gallon address1 94 Gallon address1 35 Gallon address1 94 Gallon address1 35 Gallon address1 60 Gallon address1 94 Gallon 我想消除具有相同地址的行，并将它们合并为一行，如此。

Address Bin1 Bin2 Bin3 Bin4 Bin5 Bin6 Bin7 Bin8 address1 94 Gallon 60 Gallon 94 Gallon 35 Gallon 94 Gallon 35 Gallon 60 Gallon 94 Gallon

我该怎么做？

Answer 1

使用公式需要列出单行中每个地址的所有bin：

在名为Key的A列的示例表中添加一列（参见图1）

图1

键：用于为每个地址

箱

在A2中输入此公式，然后复制到最后一条记录

=CONCATENATE($B2,".",COUNTIF($B$1:$B2,$B2))

添加从E1开始的范围，列出地址\ bin 表（参见图2）

图。 2

地址：从列B

在Formula Array中输入此为E2，然后复制到最后一条记录

{=IFERROR(INDEX($B$2:$B$22,
MATCH(SUM(COUNTIF(E$1:E1,$B$2:$B$22)),
COUNTIF($B$2:$B$22,"<"&$B$2:$B$22),0)),"")}

计数：每个地址的分档数。用它来扩展表格的宽度

在F2中输入此公式，然后复制到最后一条记录

=IF(EXACT($E2,""),"",COUNTIF($B:$B,$E2))

Bin.1到Bin.n ：垃圾箱的内容

在G2中输入此公式，然后复制到所有垃圾箱的最后一条记录

=IFERROR(VLOOKUP(CONCATENATE($E2,".",RIGHT(G$1)),$A:$C,3,0),"")

Answer 2

突出显示行。复制。粘贴时，右键单击以查看选项。使用转置数据的那个。它会将所有内容粘贴到列而不是行中。

Answer 3

以下代码应该使用您的地址并将它们组合在一起。之后，您只需添加列标题

Sub ConsolidateRows_MultipleCells()
'takes rows and consolidate one or many cells, based on one or many cells matching with above or below rows.

Dim lastRow As Long, i As Long, j As Long
Dim colMatch As Variant, colConcat As Variant, lColDest As Long

'**********PARAMETERS TO UPDATE****************
Const strMatch As String = "A"    'columns that need to match for consolidation, separated by commas
Const strConcat As String = "B"     'columns that need consolidating, separated by commas
Const lDest As Long = 2     'starting column for the consolidated items
'*************END PARAMETERS*******************

application.ScreenUpdating = False 'disable ScreenUpdating to avoid screen flashes

colMatch = Split(strMatch, ",")
colConcat = Split(strConcat, ",")

Cells(1, 1).CurrentRegion.Sort key1:=Cells(1, colMatch(0)), order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
                    False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
                    :=xlSortNormal


lastRow = range("A" & Rows.Count).End(xlUp).Row 'get last row

lColDest = lDest

For i = lastRow To 2 Step -1 'loop from last Row to one

    For j = 0 To UBound(colMatch)
        If Cells(i, colMatch(j)) <> Cells(i - 1, colMatch(j)) Then
            lColDest = lDest
            GoTo nxti
        End If
    Next

    For j = 0 To UBound(colConcat)
        range(Cells(i, strConcat), Cells(i, 1).End(xlToRight)).Copy Cells(i - 1, 1).End(xlToRight).Offset(, 1)
        lColDest = lColDest + 1
    Next

    Rows(i).Delete

nxti:
Next

application.ScreenUpdating = True 'reenable ScreenUpdating
End Sub

多行到单行操作

3 个答案: