198188

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

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2024-2-27 15:36 | 只看該作者

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

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)

樓主熱帖

198188

高中生 Rank: 3 Rank: 3

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

16^#

發表於 2024-2-29 12:56 | 只看該作者

回復 15# Andy2483

因爲我修改了一些格式，所以需要再微調程式。
附件上我基於一些實際改變而做了一些改動，程式也微調了。

account.rar (188.11 KB)

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

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

15^#

發表於 2024-2-29 11:13 | 只看該作者

回復 13# 198188

這話題範例沒有這需求,建議另上傳新範例,裡面放兩個結果表(執行前表,執行結果表),
這樣的範例讓協助者比較兩個結果表的差異,很容易知道需求是什麼

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

TOP

198188

高中生 Rank: 3 Rank: 3

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

14^#

發表於 2024-2-29 11:07 | 只看該作者

回復 13# 198188

找到方法了

Sub Test_A1()
Dim Arr, Brr, xD, xZ As Range, xF As Range, T$, R&, C&, i&, A, B

A = Worksheets("Data").Range("A1").End(xlDown).Row
For B = 2 To A
Worksheets("Data").Cells(B, 4) = Worksheets("Data").Cells(B, 5)
Next B

T = [data!E1] 'invoice no
Set xZ = [Data!a1].Cells(1, Columns.Count).End(1) 'Find Data last column
Set xF = [Data!1:1].Find(T, Lookat:=xlWhole) 'Find invoice no from Data all column?
If xF Is Nothing Then Set xZ = xZ(1, 2): Set xF = xZ 'if don't find, add one column

Set xD = CreateObject("Scripting.Dictionary")
'-------------------------------
Arr = Range([Data!c1], [Data!a1].Cells(Rows.Count, 1).End(3))
Arr(1, 1) = T 'put Arr first column on invoice
For i = 2 To UBound(Arr)
T = Arr(i, 1) & "\" & Arr(i, 2) & "\" & Arr(i, 3)
xD(T) = i 'record column place
Arr(i, 1) = 0 'set Arr first column 0,for back up to input?
Next i
'----------------------------
Brr = Range([KH!E1], [KH!a1].Cells(Rows.Count, 1).End(3))
For i = 2 To UBound(Brr)
R = xD(Brr(i, 2) & "\" & Brr(i, 3) & "\" & Brr(i, 4))
If R > 0 Then Arr(R, 1) = Arr(R, 1) + Brr(i, 5)
Next i
'----------------------------
xF.Resize(UBound(Arr)).Value = Arr

[Data!F2].Resize(UBound(Arr) - 1) = "=E2-SUM(G2:" & xZ(2).Address(0, 0) & ")" 'Column E BAL.
'RESET AND DELETE OLD RECORD
End Sub

TOP

198188

高中生 Rank: 3 Rank: 3

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

13^#

發表於 2024-2-29 10:43 | 只看該作者

回復 12# Andy2483

原本是KH 的數量copy 到Data 的欄D, 如果想將欄D 改爲欄E，這個應該在哪句修改？

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

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

12^#

發表於 2024-2-29 08:03 | 只看該作者

本帖最後由 Andy2483 於 2024-2-29 10:55 編輯

謝謝論壇,謝謝准提部林前輩指導,謝謝前輩發話題一起學習
建議前輩在得到協助代碼後試著自己逐列了解其意義,必要時自己註解,不了解的部分查論壇,或它網,或問代碼細節
以下是准提部林前輩的方案

Sub Test_A1()
Dim Arr, Brr, xD, xZ As Range, xF As Range, T$, R&, C&, i&
T = [Invoice!G5] '單號
If Not T Like "INV########" Then Exit Sub '單號不符合INV+8位日期..跳出
Set xZ = [Data!a1].Cells(1, Columns.Count).End(1)  '找data第一行最後非空
Set xF = [Data!1:1].Find(T, Lookat:=xlWhole) '找單號在data的欄位
If xF Is Nothing Then Set xZ = xZ(1, 2): Set xF = xZ '若單號不存在, 增加一欄
Set xD = CreateObject("Scripting.Dictionary")
'-------------------------------
Arr = Range([Data!c1], [Data!a1].Cells(Rows.Count, 1).End(3))
Arr(1, 1) = T '將Arr第一欄首格放入"單號"
For i = 2 To UBound(Arr)
T = Arr(i, 1) & "\" & Arr(i, 2) & "\" & Arr(i, 3)
xD(T) = i '字典記憶行位置
Arr(i, 1) = 0  '將Arr第一欄放入0, 以備填入數量
Next i
'----------------------------
Brr = Range([Invoice!h1], [Invoice!a1].Cells(Rows.Count, 1).End(3))
For i = 2 To UBound(Brr)
R = xD(Brr(i, 3) & "\" & Brr(i, 4) & "\" & Brr(i, 5))
If R > 0 Then Arr(R, 1) = Arr(R, 1) + Brr(i, 6)
Next i
'----------------------------
xF.Resize(UBound(Arr)).Value = Arr
With Range([Data!F1], xZ).Resize(UBound(Arr)) '單號欄格式
   .ColumnWidth = 15 '統一欄寬
   .Borders.LineStyle = 1 '加框
   .HorizontalAlignment = xlCenter '縱置中
   .VerticalAlignment = xlCenter   '橫置中
End With
[Data!e2].Resize(UBound(Arr) - 1) = "=D2-SUM(F2:" & xZ(2).Address(0, 0) & ")" 'E欄"結餘"公式(隨欄數變化)..刪去欄也可正確計算
End Sub

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

TOP

198188