Option Explicit
Sub TEST()
Dim Brr(1 To 1000, 1 To 4), Crr, A(3), Y, X&, R&, i&, C%, j%, K%, P$, Q$
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Range([D2], [D65536].End(3)(2)).ClearContents
'↑令結果欄儲存格清除內容
A(1) = Range([D2], [A65536].End(3))
A(2) = Range([I2], [F65536].End(3))
A(3) = Range([M2], [J65536].End(3))
'↑令A變數這 一維陣列的1~3陣列值各為二維陣列,各以儲存格值帶入
For i = 1 To 3
For R = 1 To UBound(A(i))
X = X + 1
For C = 1 To 4: Brr(X, C) = A(i)(R, C): Next
Next
Next
'↑設迴圈將3個二維陣列寫入Brr陣列裡
C = Range([A1], ActiveSheet.UsedRange).Columns.Count
'↑令C變數是偵測使用儲存格最右邊欄數
With Cells(1, C + 1).Resize(X, 4)
'↑在使用儲存格右側增設輔助儲存格(不影響原始資料為原則)
.Value = Brr
.Sort KEY1:=.Item(1), Order1:=1, _
Key2:=.Item(2), Order2:=1, _
key3:=.Item(3), Order3:=2, _
Header:=xlNo, Orientation:=xlTopToBottom
'↑將陣列值寫入輔助儲存格後,做3層排序
Crr = .Value
'↑令Crr變數是 二維陣列,裝入輔助儲存格排序後的值
For i = 1 To UBound(Crr)
'↑設順迴圈!
P = Crr(i, 1) & "|" & Crr(i, 2) & "|" & Crr(i, 3)
'↑令P是1~3欄i迴圈列Crr陣列,以"|"間隔組成的新字串
If InStr(P, Q) <> 1 Then K = 10
'↑因為有些薪資大於10級薪資,而排序時列在迴圈最前面,
'所以只要偵測到(性質|職別)不同前一迴圈,就先令K=10
If Crr(i, 4) <> "" Then
Q = Crr(i, 1) & "|" & Crr(i, 2): K = Crr(i, 4)
End If
Y(P) = K
'↑令P這組合字串當key,item是K變數,納入Y字典裡
Next
.EntireColumn.Delete
'↑令輔助儲存格欄位刪除
End With
Crr = A(1)
'↑令Crr換裝 A(1)這二維陣列
For i = 1 To UBound(Crr)
'↑設順迴圈
P = Crr(i, 1) & "|" & Crr(i, 2) & "|" & Crr(i, 3)
Crr(i, 1) = Y(P)
'↑令以P這組合字串查Y字典得到的item值寫入Crr陣列第1欄裡,
'寫在Crr陣列第1欄的原因是方便將陣列值寫入儲存格裡,
'畢竟第1欄的陣列值除了被用來組合成P變數也沒有用途了
Next
[D2].Resize(UBound(Crr), 1) = Crr
'↑令Crr陣列第1欄值寫入從[D2]開始的儲存格中
Set Y = Nothing: Erase Brr, Crr, A
'↑令釋放變數
End Sub
