2014-11-21 26 views
0

我有一列card_id的和另一列日 現在,每列有列b條件移調 - Excel中

的多個值,例如:

column a column b 

    1   10/12/2011  
    1   10/01/2014 
    2   01/02/2013  
    2   01/03/2014 
    2   02/03/2014 
    2   10/09/2014 
    3   05/06/2012 
    3   02/03/2013 

我想這些作爲顯示:

列一個

   date 1  date 2  date 3  date 4 
    1   10/12/2011 10/01/2014 - 
    2   01/02/2013 01/03/2014 02/03/2014 10/09/2014 
    3   05/06/2012 02/03/2013 
+0

相關:http://stackoverflow.com/questions/27070873/column-a-has-multiple-values-for-column-b-get-in-rows – pnuts 2014-11-22 04:23:52

回答

1

我可能只是宏觀你,她Ë是:

Sub ConsolidateRows_MultipleColumns() 
'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"  'columns that need consolidating, separated by commas - should be rightmost column 
Const strSep As String = "|"  'string that will separate the consolidated values, use a value that's not in the consolidated strings 
'*************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 

Columns(strConcat).TextToColumns Destination:=Columns(strConcat).Cells(1, 1), DataType:=xlDelimited, _ 
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ 
    :=strSep 

application.ScreenUpdating = True 'reenable ScreenUpdating 
End Sub