返回列表 上一主題 發帖

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

david1216jp

帖子
12 
主題
5 
精華
0 
積分
67 
點名
0  
作業系統
windows 10 
軟體版本
office 365 
閱讀權限
20 
性別
男 
註冊時間
2017-3-27 
最後登錄
2021-7-4 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2020-3-9 18:43 | 只看該作者

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

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

原始：

最後呈現的結果：


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

資料比對.zip (7.7 KB)

收藏 分享

Kubi

帖子
163 
主題
1 
精華
0 
積分
170 
點名
0  
作業系統
Window 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2010-9-5 
最後登錄
2022-7-20 
2#
發表於 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
複製代碼

TOP

david1216jp

帖子
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

帖子
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

帖子
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

        靜思自在 : 有多少力量就做多少事，不要心存等待，等待才會落空。
返回列表 上一主題