Board logo

標題: [發問]請教有關VBA資料比對 [打印本頁]
作者: david1216jp    時間: 2020-3-9 18:43     標題: [發問]請教有關VBA資料比對

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

原始：
[attach]31771[/attach]
最後呈現的結果：
[attach]31772[/attach]

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

回復 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    時間: 2020-3-11 16:05

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

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    時間: 2020-3-16 11:51

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)