在VBA中合并行

时间:2017-10-13 15:29:57

标签: vba excel-vba excel

如果客户和出生日期列在行之间匹配,我想总结收入。

account number  customer    Date of Birth   Country $ Revenue StartD    
    47971           MARTY-ANE    27/12/1957     IF_FR_OU    100 10022010
    48045           QUESNEL      06/05/1956     IF_FR_OU    200 11022010
    47999           MARTY-ANE    27/12/1957     IF_IT_OU    100 12022010

我想看起来像这样:

 account number customer Date of Birth  Country $ Revenue StartD    
47971 & 47999   MARTY-ANE    27/12/1957 IF_FR_OU    200  10022 & 12022 
48045           QUESNEL  06/05/1956     IF_FR_OU    200  11022

代码:

 Sub ProcessCustomers()
 Dim key As Variant, values As Variant, results As Variant
 Dim list As Object
 Dim x As Long, IndexOf As Long
 Set list = CreateObject("System.Collections.ArrayList")
 'account number|customer|Date of Birth|Country|$ Revenue

  With Worksheets("Sheet1")
    For x = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        key = .Cells(x, 2).Value & "|" & .Cells(x, 3).Value & "|" & 
  .Cells(x, 4).Value
        If list.Count = 0 Then ReDim results(0 To 4, 0 To 0)

        If list.Contains(key) Then
            IndexOf = list.LastIndexOf(key)
            results(0, IndexOf) = results(0, IndexOf) & " & " & 
  .Cells(x, 1).Value
            results(4, IndexOf) = results(4, IndexOf) + .Cells(x, 
  5).Value
        Else
            list.Add key
            ReDim Preserve results(0 To 4, 0 To list.Count - 1)
            IndexOf = list.Count - 1
            results(0, IndexOf) = .Cells(x, 1).Value
            results(1, IndexOf) = .Cells(x, 2).Value
            results(2, IndexOf) = .Cells(x, 3).Value
            results(3, IndexOf) = .Cells(x, 4).Value
            results(4, IndexOf) = .Cells(x, 5).Value
        End If
    Next
 End With
'Transpose results and change the Array Base from 0 to 1
results = Application.Transpose(results)
With Worksheets.Add
    .Range("A1").Resize(1, 5).Value = Split("account 
 number|customer|Date of Birth|Country|$ Revenue", "|")
    .Range("A1").Resize(UBound(results), UBound(results, 2)).Value = 
 results
 End With
 End Sub

1 个答案:

答案 0 :(得分:0)

无需代码。按客户排序,dateofbirth。然后使用Data,Subtotal ...... 每次更改dateofbirth时,总收入