返回列表 上一主題 發帖

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

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

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 沒有找到的項目,彈出視窗列出這些組合

範例C.rar (138.72 KB)

本帖最後由 Andy2483 於 2024-2-27 16:41 編輯

回復 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
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 2# Andy2483


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

TOP

回復 3# 198188

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

TOP

回復 4# Andy2483


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

TOP

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

TOP

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

Xl0000200.rar (131.99 KB)

TOP

回復 7# 准提部林

如果有重複,這個有沒有自動加總數量?

TOP

回復 8# 198188


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

TOP

回復 9# 准提部林

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

TOP

        靜思自在 : 脾氣嘴巴不好,心地再好也不能算是好人。
返回列表 上一主題