将行与公共列合并

我怎样才能合并具有相同的date行? 合并/中心function不起作用。 删除重复也不起作用。 谢谢。

在这里输入图像描述

试试这个代码将整合与匹配date的行:

Sub ConsolidateRows() '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 '**********PARAMETERS TO UPDATE**************** Const strMatch As String = "A" 'columns that need to match for consolidation, separated by commas Const strConcat As String = "B,C,D" 'columns that need consolidating, separated by commas Const strSep As String = "" 'string that will separate the consolidated values '*************END PARAMETERS******************* application.ScreenUpdating = False 'disable ScreenUpdating to avoid screen flashes colMatch = Split(strMatch, ",") colConcat = Split(strConcat, ",") lastRow = range("A" & Rows.Count).End(xlUp).Row 'get last row 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 GoTo nxti Next For j = 0 To UBound(colConcat) Cells(i - 1, colConcat(j)) = Cells(i - 1, colConcat(j)) & strSep & Cells(i, colConcat(j)) Next Rows(i).Delete nxti: Next application.ScreenUpdating = True 'reenable ScreenUpdating End Sub