返回列表 上一主題 發帖

職級判別

請教各位前輩:
這範例如何用VBA方式處理?
謝謝各位前輩
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

謝謝論壇,謝謝各位前輩
昨天這帖想不到方法,暫時擱下,昨晚運動完突然想到用參照表與資料表以輔助欄混和排序,就可以明確知道職級,將他納入字典,再吐出來
今天早上將昨晚想到的方法實現,學習方案如下,請各位前輩指導更好的辦法

執行前:


輔助欄排序後:


執行結果:



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

TOP

        靜思自在 : 好事要提得起,是非要放得下,成就別人即是成就自己。
返回列表 上一主題