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

有兩個表 Read & Data

Data 是資料檔案
Read 是程式執行檔案

執行程式規則：
Read 表灰色部分是原有資料，保留。
Read 表 A 欄  對比 Data 表 H 欄，
若吻合，複製 Data 表對應的一列資料到 Read 表 A 欄最後一列後, 數量 Read 表  Qty * Data 表 Qty （如藍色部分）
完成後，再重複一次
Read 表 A 欄  對比 Data 表 H 欄，
若吻合，複製 Data 表對應的一列資料到 Read 表 A 欄最後一列後, 數量 Read 表  Qty * Data 表 Qty （如綠色色部分）

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

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

8^#

發表於 1 分鐘前 | 只看該作者

Brr = Range([Data!A1], [Data!A1].CurrentRegion.Offset(UBound(Brr)))

請問前輩，這句如果想改
x ...
198188 發表於 2025-11-6 15:12

With Workbooks("Data Base.xlsx").Sheets("Data")
Brr = .Range(.[A1], .[A1].CurrentRegion.Offset(UBound(Brr)))
End With

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

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 541
主題: 72
精華: 0
積分: 638
點名: 1
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2025-11-6

7^#

發表於 26 分鐘前 | 只看該作者

回復 198188

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

Option Explicit
Sub ...
Andy2483 發表於 2025-11-6 14:16

Brr = Range([Data!A1], [Data!A1].CurrentRegion.Offset(UBound(Brr)))

請問前輩，這句如果想改
xFile = "Data Base.xlsx"
sheets ("Data")
應該如何套入？

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 541
主題: 72
精華: 0
積分: 638
點名: 1
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2025-11-6

6^#

發表於 1 小時前 | 只看該作者

Option Explicit
Sub TEST()
Dim arr, 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
arr = Sheets("Read").UsedRange
Sheets("Read").Range("A" & UBound(arr) + 1).Resize(N, UBound(Brr, 2)) = Brr
End Sub

複製代碼

回復 198188

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

Option Explicit
Sub ...
Andy2483 發表於 2025-11-6 14:16

前輩我修改如上。

TOP

Andy2483

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

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

5^#

發表於 1 小時前 | 只看該作者

回復 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