返回列表 上一主題 發帖

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

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

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

原始:
資料比對.jpg
2020-3-9 18:26

最後呈現的結果:
資料比對_結果.jpg
2020-3-9 18:39


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

資料比對.zip (7.7 KB)

回復 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
複製代碼

TOP

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

TOP

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
互相交流

TOP

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

TOP

        靜思自在 : 做好事不能少我一人,做壞事不能多我一人。
返回列表 上一主題