尋找有沒有相同數據的欄位

198188

Data 表的資料來讀取 Invoice 表的資料, 先找尋Data 表所有欄有沒有跟Invoice 表儲存格G5 相同的。

如果有，在該欄操作下面：
Data表 欄A 對比  Invoice表 欄C
Data表 欄B 對比  Invoice表 欄D
Data表 欄C 對比  Invoice表 欄E
三樣都相同，讀取 Invoice 表 欄F 的數值到Data 表跟Invoice G5 表儲存格相同的該欄位

如果沒有，在最後一欄操作下面：
Data表 欄A 對比  Invoice表 欄C
Data表 欄B 對比  Invoice表 欄D
Data表 欄C 對比  Invoice表 欄E
三樣都相同，讀取 Invoice 表 欄F 的數值到Data 表最後一欄

Data表欄E 計算: Data表欄D 減 Data表欄F 開始到最後有數值的一欄

如果Invoice 表 欄C - E組合在Data 表欄A - C 沒有找到的項目，彈出視窗列出這些組合

Andy2483

回復 1# 198188

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

Option Explicit
'此段是 找尋Data 表所有欄有跟Invoice 表儲存格G5 相同的,
'三樣都相同，讀取 Invoice 表 欄F 的數值到Data 表跟Invoice G5 表儲存格相同的該欄位
Sub TEST()
Dim Brr, Z, i&, c, T$, T1$, T2$, T3$
c = Application.Match([Invoice!G5], [Data!1:1], 0)
Set Z = CreateObject("Scripting.Dictionary")
If IsError(c) Then MsgBox "找不到G5關鍵字": Exit Sub
Brr = Range([Invoice!F12], [Invoice!C65536].End(3))
For i = 1 To UBound(Brr)
   T1 = Trim(Brr(i, 1)): T2 = Val(Brr(i, 2)): T3 = Val(Brr(i, 3)): T = T1 & "/" & T2 & "/" & T3
   If T1 = "" Then GoTo i01
   Z(T) = Val(Brr(i, 4))
i01: Next
Brr = [Data!A1].CurrentRegion
For i = 2 To UBound(Brr)
   T1 = Trim(Brr(i, 1)): T2 = Val(Brr(i, 2)): T3 = Val(Brr(i, 3)): T = T1 & "/" & T2 & "/" & T3
   If T1 = "" Or Z(T) = "" Then Brr(i - 1, 1) = "": GoTo i02
   Brr(i - 1, 1) = Z(T)
i02: Next
[Data!A1].Item(2, c).Resize(UBound(Brr) - 1) = Brr
End Sub

198188

回復 2# Andy2483


    如果找不到G5, 應該把所有參數導入到最後一行，不是顯示“找不到G5的參數”

Andy2483

回復 3# 198188

請前輩自己先試試看

198188

回復 4# Andy2483


    能不能告知怎樣找最後一欄，我只懂得找最後一行。
另外最後有個計算，欄D 減去 欄F 到最後一行，這句應該如何寫？

198188

回復 4# Andy2483

我修改了如下，滿足了所有要求。

Option Explicit
Sub TEST3()
Dim Brr, Z, i&, c, T$, T1$, T2$, T3$, a, b, d
Dim ColNum As Long
c = Application.Match([Invoice!G5], [Data!1:1], 0)

If IsError(c) Then
ColNum = Worksheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column
Worksheets("Data").Cells(1, ColNum + 1) = Worksheets("Invoice").Cells(5, 7)
End If

c = Application.Match([Invoice!G5], [Data!1:1], 0)
Set Z = CreateObject("Scripting.Dictionary")

Brr = Range([Invoice!F10], [Invoice!C65536].End(3))
For i = 1 To UBound(Brr)
   T1 = Trim(Brr(i, 1)): T2 = Val(Brr(i, 2)): T3 = Val(Brr(i, 3)): T = T1 & "/" & T2 & "/" & T3
   If T1 = "" Then GoTo i01
   Z(T) = Val(Brr(i, 4))
i01: Next
Brr = [Data!A1].CurrentRegion
For i = 2 To UBound(Brr)
   T1 = Trim(Brr(i, 1)): T2 = Val(Brr(i, 2)): T3 = Val(Brr(i, 3)): T = T1 & "/" & T2 & "/" & T3
   If T1 = "" Or Z(T) = "" Then Brr(i - 1, 1) = "": GoTo i02
   Brr(i - 1, 1) = Z(T)
i02: Next
[Data!A1].Item(2, c).Resize(UBound(Brr) - 1) = Brr

a = Worksheets("Data").Range("A1").End(xlDown).Row
d = Worksheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To a
Worksheets("Data").Cells(i, 5) = Worksheets("Data").Cells(i, 4) - Application.WorksheetFunction.Sum(Worksheets("Data").Range(Cells(i, 6), Cells(i, d + 1)))
Next i

End Sub

准提部林

有則汰舊換新, 無則新增//

Xl0000200.rar (131.99 KB)

下載次數: 10

2024-2-28 11:31

198188

回復 7# 准提部林

如果有重複，這個有沒有自動加總數量？

准提部林

回復 8# 198188


invioce 若有重覆, 會加總,
注意:data表是重新匯總, 舊的會先清除

198188

回復 9# 准提部林

測試過，的確可以。
請問可否最後加一個功能，提醒INVOICE 有哪些在DATA 找不到的所有項目。
可以用顔色highlight這些項目 或者彈個視窗顯示這些的明細