帖子: 63
主題: 34
精華: 0
積分: 103
點名: 0
作業系統: XP
軟體版本: office 2007
閱讀權限: 20
性別: 女
註冊時間: 2010-8-5
最後登錄: 2024-10-17

論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2024-3-28 11:58 | 只看該作者

[發問] 多條件比對

請問如何按部門、年資及薪資比對出等級，謝謝。

年資薪資等級.zip (7.27 KB)

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

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

5^#

發表於 2024-3-29 08:19 | 只看該作者

回復 3# Andy2483

謝謝論壇,謝謝各位前輩
後學檢視到如果薪資剛好同對照表金額,會誤判為資料錯誤,修正如下:

Option Explicit
Sub TEST()
Dim Brr, Crr, Z, i&, j%, R&, C%, TT$, T$, T1$, T2$
'↑宣告變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是字典
Brr = Range([I1], [F65536].End(3)): R = UBound(Brr): C = UBound(Brr, 2)
'↑令Brr變數是以儲存格值帶入的二維陣列,令R/C變數是陣列縱/橫向最大索引號
For i = 2 To UBound(Brr): For j = 1 To 3: T = T & "/" & Brr(i, j): Next: Z(T) = i: T = "": Next
'↑設順迴圈將3欄陣列值以"/"字元串聯成的新字串當key,item是列號,納入Z字典裡
Range([D2], [A65536].End(3)).Copy: [F2].Insert Shift:=xlDown
'↑令將對照資料複製插入目標資料上方
With Range([I1], [F65536].End(3))
.Sort KEY1:=.Item(1), Order1:=1, Key2:=.Item(2), Order2:=1, Key3:=.Item(3), Order3:=2, Header:=1
'↑令資料做三層排序有標題列排序,1/2層做漸增,第3層漸減
Crr = .Value: .ClearContents: [F1].Resize(R, C) = Brr
'↑令Crr變數是以該範圍儲存格值帶入的二維陣列
End With
For i = 2 To UBound(Crr)
'↑設順迴圈!令i從2 到Crr陣列縱向最大索引列號
If Crr(i, 4) <> "" And T <> Crr(i, 4) Then T = Crr(i, 4): T1 = Crr(i, 1): T2 = Crr(i, 2): GoTo i01
'↑如果迴圈等級欄陣列值不是空字元,且與T變數不同! 就令T變數是迴圈等級欄陣列值,
'令T1變數是迴圈部門欄陣列值,T2變數是迴圈年資欄陣列值,然後跳到標示i01位置繼續執行
TT = "/" & T1 & "/" & T2 & "/" & Crr(i, 3)
'↑令TT變數是新組合字串
If T1 <> Crr(i, 1) Or T2 <> Crr(i, 2) Or Not Z.Exists(TT) Then MsgBox "資料錯誤": Exit Sub
'↑如果目標資料有異常或對照資料異常,就跳出提示窗~~,結束程式執行
Brr(Z(TT), 4) = T
'↑令Z字典裡記錄列號第4欄的Brr陣列值是 T變數
i01: Next
[F1].Resize(R, C) = Brr
'↑令[F1]擴展R列C欄範圍儲存格值以 Brr陣列值寫入
End Sub

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

TOP

hcm19522

大學生 Rank: 4

帖子: 1391
主題: 4
精華: 0
積分: 1401
點名: 0
作業系統: WIN
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2015-9-11
最後登錄: 2024-12-16

熱烈參與勳章

4^#

發表於 2024-3-28 15:33 | 只看該作者

本帖最後由 hcm19522 於 2024-3-28 15:50 編輯

參考 (搜尋輸入編號12565) google網址:https://hcm19522.blogspot.com/
{=OFFSET(D1,MATCH(1,(A2:A11=F2)*(B2:B11=G2)*(C2:C11>=H2),),)

google"EXCEL迷" blog 或google網址:https://hcm19522.blogspot.com/

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

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

3^#

發表於 2024-3-28 15:04 | 只看該作者

回復 2# shootingstar

謝謝前輩發表此主題與範例
後學藉此帖練習VBA陣列與字典,學習方案如下,請前輩參考

Option Explicit
Sub TEST()
Dim Brr, Crr, Z, i&, j%, R&, C%, TT$, T$, T1$, T2$, xR As Range
Set Z = CreateObject("Scripting.Dictionary")
Set xR = [F65536].End(3): Brr = Range([I1], xR): R = UBound(Brr): C = UBound(Brr, 2)
For i = 2 To UBound(Brr): For j = 1 To 3: T = T & "/" & Brr(i, j): Next: Z(T) = i: T = "": Next
Range([D2], [A65536].End(3)).Copy xR(2)
With Range([I1], [F65536].End(3))
.Sort KEY1:=.Item(1), Order1:=1, Key2:=.Item(2), Order2:=1, Key3:=.Item(3), Order3:=2, Header:=1
Crr = .Value: .ClearContents: [F1].Resize(R, C) = Brr
End With
For i = 2 To UBound(Crr)
If Crr(i, 4) <> "" And T <> Crr(i, 4) Then T = Crr(i, 4): T1 = Crr(i, 1): T2 = Crr(i, 2): GoTo i01
TT = "/" & T1 & "/" & T2 & "/" & Crr(i, 3)
If T1 <> Crr(i, 1) Or T2 <> Crr(i, 2) Or Not Z.Exists(TT) Then MsgBox "資料錯誤": Exit Sub
Brr(Z(TT), 4) = T
i01: Next
[F1].Resize(R, C) = Brr
End Sub

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

TOP

shootingstar

中學生 Rank: 2

帖子: 63
主題: 34
精華: 0
積分: 103
點名: 0
作業系統: XP
軟體版本: office 2007
閱讀權限: 20
性別: 女
註冊時間: 2010-8-5
最後登錄: 2024-10-17

論壇榮譽勳章論壇贊助勳章

2^#

發表於 2024-3-28 13:10 | 只看該作者

請問如何按部門、年資及薪資比對出等級，謝謝。
shootingstar 發表於 2024-3-28 11:58

不好意思，應以此表計算等級

年資薪資比對等級.jpg (103.48 KB)

TOP