如果特定數據相同，則合併行

Question

我有一些時間表數據，我需要簡化並且無法在任何地方找到宏。 我見過一些類似的東西，但需要一個vba來修改實際的數據，因爲在這一步之後我使用其他一些宏來修改數據/外觀更遠。

白天我們可能會在幾次不同的時間工作，所以我們在案例中創建了幾個條目。

我需要一個宏，將每一行與其他所有行進行比較，因爲數據通常並不緊挨着，然後將它們合併。如果案例編號（G），計費狀態（B）和日期（A）相同，我想合併兩行，但將兩個時間段加在一起分鐘（E）和小時（F）

樣本數據：

Data(A) Bill(B) Contact(C) Customer(D) Min(E) Hours(F)Case#(G) 
---------------------------------------------------------------- 
7/5/2011 No Lynda  Customer1 15.000 0.25 524503 
7/5/2011 No Adam  Customer2 15.000 0.25 523592 
7/5/2011 No Adam  Customer2 15.000 0.25 523592 
7/6/2011 No Adam  Customer2 15.000 0.25 523592 

因此宏觀需求的行結合起來，看起來像：

7/5/2011 No Lynda  Customer1 15.000 0.25 524503 
7/5/2011 No Adam  Customer2 30.000 0.5  523592 
7/6/2011 No Adam  Customer2 15.000 0.25 523592 

贊成嗎？謝謝！

Answer 1

你起草了一些代碼嗎？我們可以嘗試幫助您達成您的解決方案，改善您的代碼...

我會這樣（如果您不知道如何構建代碼，請問我們會幫助您） ：

• 創建一個Dictionary對象（最好的方式來擺脫在VBA重複信息）
• 掃描每一行，添加到所有指標值的字典關鍵串聯，並作爲該值鍵，具有每列值的數組
• 當檢測到密鑰已存在時，執行所需列的總和S（分鐘，例如）
• 打印背面的字典到電子表格

瞧。

示例代碼，它執行部分技巧（不打印回來，但將這些值相加並將它們存回字典中）。

我直接存儲單元，而不是他們的價值觀，只是因爲我沒有現在太多的時間來處理陣列...

編輯：要使用的Scripting.Dictionary，去工具/引用並檢查「Microsoft腳本運行時」。

編輯＃2：添加了打印分組數據的代碼。您可能需要根據您的要求調整代碼...但它回答了您的問題。

Option Explicit 

Sub test() 

    Dim oRange As Excel.Range 
    Dim oTarget As Excel.Range 
    Dim oRow As Excel.Range 
    Dim oRowAmend As Excel.Range 
    Dim oDic As Scripting.Dictionary 
    Dim sIndex As String 
    Dim vKey As Variant 
    Dim vItem As Variant 

    'Define the source range. Remember to bypass the header! 
    Set oRange = Sheets("MySheet").Range("A2:G5") 

    'Define where the updated data will be printed... 
    Set oTarget = Sheets("MySheet").Range("A12:G12") 

    Set oDic = New Scripting.Dictionary 

    For Each oRow In oRange.Rows 

     'Define Indexes 
     sIndex = Trim(oRow.Cells(1)) & Trim(oRow.Cells(2)) & Trim(oRow.Cells(3)) 

     'If the index exists, sum the values 
     If oDic.Exists(sIndex) Then 

      Set oRowAmend = oRow 

      oRowAmend.Cells(5).Value = oRow.Cells(5).Value + oRowAmend.Cells(5).Value 

      oDic.Remove (sIndex) 
      oDic.Add sIndex, oRowAmend 

     'If does not exist, only store their values 
     Else 

      oDic.Add sIndex, oRow 

     End If 

    Next oRow 

    For Each vKey In oDic 

     vItem = oDic.Item(vKey) 
     oTarget = vItem 

     'Points oTarget for next row... 
     Set oTarget = oTarget.Offset(1, 0) 

    Next vKey 

End Sub 

希望它有幫助。