兩表資料重複對比並數量相乘 - Excel程式區

1 23

返回列表下一主題上一主題發帖

[發問] 兩表資料重複對比並數量相乘

Andy2483

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

帖子: 1567
主題: 40
精華: 0
積分: 1591
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2026-2-2

5^# 跳轉到 »

發表於 2025-11-6 14:16 | 只看該作者

回復 3# 198188

謝謝前輩發表此主題與範例,後學學習方案如下,請前輩參考

Option Explicit
Sub TEST()
Dim Brr, Z, K, i&, j%, N&
Set Z = CreateObject("Scripting.Dictionary")
Brr = [Read!A1].CurrentRegion
For i = 2 To UBound(Brr): Z(Brr(i, 1)) = Val(Brr(i, 3)): Next
Brr = Range([Data!A1], [Data!A1].CurrentRegion.Offset(UBound(Brr)))
For i = 2 To UBound(Brr)
If Z.Exists(Brr(i, 8)) Then
   Z(Brr(i, 1) & "/") = i
   Brr(i, 3) = Z(Brr(i, 8)) & "*" & Val(Brr(i, 3))
End If
If Z.Exists(Brr(i, 8) & "/") Then
   Z(Brr(i, 8) & "//") = i
   Brr(i, 3) = Brr(Z(Brr(i, 8) & "/"), 3) & "*" & Val(Brr(i, 3))
End If
Next
For Each K In Z.Keys
If InStr(K, "/") Then
   N = N + 1
   For j = 1 To UBound(Brr, 2): Brr(N, j) = Brr(Z(K), j): Next
   'Brr(N, 3) = "=" & Brr(N, 3)
End If
Next
Workbooks.Add
[A1].Resize(N, UBound(Brr, 2)) = Brr
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

hcm19522