利用VBA代碼批量填充職位升降信息

王志軍

人事部的同事前來求助（如圖1），E列是職位升降及留用情況的信息，現在需要對現職位和原崗位進行比較，如果發現現職位和原崗位出現不一致，那么需要在F列填充職位的升降時間，并在G列填充升降明細。除了手工操作之外，有沒有簡單一些的方法呢？

經過考慮，由于單元格中的職位升降及留用信息并不規范，因此無法直接使用分列功能，建議同事使用VBA代碼解決這一問題：按下“Alt+F11”組合鍵，打開Microsoft Visual Basic for Applications編輯器窗口，依次選擇“插入/模塊”，在右側窗格插入一個空白模塊（如圖2），在這里手工輸入或粘貼如下代碼：

Sub test（）

Set reg = CreateObject（"vbscript.regexp"）

With reg

.Global = True

.Pattern = "（＼d{1，2}＼-＼d{1，2}）（由.*）"

End With

With Sheet1

For Each Rng In .Range（"e2：e" & .Cells（Rows.Count， "e"）.End（xlUp）.Row）

Set mat = reg.Execute（Rng.Value）

For Each m In mat

Rng.Offset（， 1） = m.submatches（0）

Rng.Offset（， 2） = m

Next

Next

End With

End Sub

上述代碼運用了正則表達式，例如“（＼d{1，2}＼-＼d{1，2}）（由.*）”，同時以“由”為關鍵字進行提取。檢查無誤之后，選擇“文件→關閉并返回到Microsoft Excel”命令，返回Excel主界面，按下“Alt+F8”組合鍵，打開“宏”對話框，選擇并運行test宏，很快就可以得到結果（如圖3）。

Ps：相關VBA代碼可以關注電腦迷微信（微信號：cpcfan），回復1502VBA2獲得下載鏈接。