[發問]請教有關VBA資料比對

david1216jp

各位前輩您好，
想請教如何使用VBA製作將左邊的總表對應欄位的資料，快速填入右端的總表之中，
資料對應的部分excel中可以用sumif的函數來處理，小弟想詢問是否還有更快的方法，
還請前輩或高手指導，非常感謝~~

原始：

下載 (122.68 KB)

2020-3-9 18:26

最後呈現的結果：

下載 (76.48 KB)

2020-3-9 18:39

P.S.
1. A欄與L欄是對應的Key
2. 左端總表出現的列數不定，但是可能會出現重複的(如左邊總表第5列與第9列，第6列與第8列)
3. 若出現重複的部分，金額要加總
4. 若對應不到，右端總表要補上0

Kubi

回復 1# david1216jp
請參考。

1. Sub test()
   
2.     Dim arr
   
3.     Dim d As Object
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     [A1,L1].Value = ""
   
6.     arr = [B2].CurrentRegion
   
7.     For i = 2 To UBound(arr, 2)
   
8.         For j = 2 To UBound(arr)
   
9.             d(arr(1, i) & arr(j, 1)) = d(arr(1, i) & arr(j, 1)) + arr(j, i)
   
10.         Next j
    
11.     Next i
    
12.     arr = [M2].CurrentRegion
    
13.     For i = 2 To UBound(arr, 2)
    
14.         For j = 2 To UBound(arr)
    
15.             If d(arr(1, i) & arr(j, 1)) = "" Then
    
16.                 arr(j, i) = 0
    
17.             Else
    
18.                 arr(j, i) = d(arr(1, i) & arr(j, 1))
    
19.             End If
    
20.         Next j
    
21.     Next i
    
22.     [M2].CurrentRegion = arr
    
23.     [A1,L1].Value = "總表"
    
24.     Set d = Nothing
    
25.     arr = ""
    
26. End Sub

複製代碼

david1216jp

感謝Kubi大大提供方法，我這端再試試看，非常感謝您的幫忙~~
我這端在論壇、網路爬文只有解決傳送值的方法(左邊→右邊)，但是合併同列金額的部分就卡住了，這裡真的臥虎藏龍，再次感謝Kubi前輩!!

adrian_9832

Sub test()

i = 3
Do Until Cells(i, 1) = ""

    Index_a = Cells(i, 1)


    k = 3
    Do Until Cells(k, 12) = ""
        Index_b = Cells(k, 12)

   
        If Index_a = Index_b Then
            For t = 1 To 9
                Cells(k, 12 + t) = Cells(k, 12 + t) + Cells(i, 1 + t)
            Next t
        End If
        
    k = k + 1
    Loop




i = i + 1
Loop







End Sub


還沒做 4. 若對應不到，右端總表要補上0
互相交流

david1216jp

抱歉，一忙忘了回覆大家~~
感謝Kubi大大與adrian_9832大大，我自己也還在學習中，再次感謝!!