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

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

原始：

最後呈現的結果：

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

資料比對.zip (7.7 KB)

樓主熱帖

Kubi

中學生 Rank: 2

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

2^#

發表於 2020-3-11 14:36 | 只看該作者

回復 1# david1216jp
請參考。

Sub test()
Dim arr
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
[A1,L1].Value = ""
arr = [B2].CurrentRegion
For i = 2 To UBound(arr, 2)
For j = 2 To UBound(arr)
d(arr(1, i) & arr(j, 1)) = d(arr(1, i) & arr(j, 1)) + arr(j, i)
Next j
Next i
arr = [M2].CurrentRegion
For i = 2 To UBound(arr, 2)
For j = 2 To UBound(arr)
If d(arr(1, i) & arr(j, 1)) = "" Then
arr(j, i) = 0
Else
arr(j, i) = d(arr(1, i) & arr(j, 1))
End If
Next j
Next i
[M2].CurrentRegion = arr
[A1,L1].Value = "總表"
Set d = Nothing
arr = ""
End Sub

複製代碼

TOP

david1216jp

中學生 Rank: 2

帖子: 12
主題: 5
精華: 0
積分: 67
點名: 0
作業系統: windows 10
軟體版本: office 365
閱讀權限: 20
性別: 男
註冊時間: 2017-3-27
最後登錄: 2021-7-4

3^#

發表於 2020-3-11 16:05 | 只看該作者

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

TOP

adrian_9832

中學生 Rank: 2

帖子: 79
主題: 19
精華: 0
積分: 148
點名: 0
作業系統: WINDOW7
軟體版本: EXCEL 2003
閱讀權限: 20
性別: 男
註冊時間: 2017-5-21
最後登錄: 2023-3-13

4^#

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

TOP

david1216jp

中學生 Rank: 2

帖子: 12
主題: 5
精華: 0
積分: 67
點名: 0
作業系統: windows 10
軟體版本: office 365
閱讀權限: 20
性別: 男
註冊時間: 2017-3-27
最後登錄: 2021-7-4

5^#

發表於 2020-3-16 11:51 | 只看該作者

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

TOP