|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Option Explicit
Sub TEST6()
Dim ar, br, i&, j&, r&, dic As Object, vKey
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary")
ar = [A1].CurrentRegion.Value
For i = UBound(ar) To 2 Step -1
dic(ar(i, 3)) = dic(ar(i, 3)) & " " & ar(i, 1)
Next i
ReDim ar(dic.Count, 1) As String
ar(0, 0) = "工号": ar(0, 1) = "机构内"
For Each vKey In dic.keys
br = Split(dic(vKey))
r = r + 1
ar(r, 0) = vKey
For i = 1 To UBound(br)
If br(i) = "跨机构轮岗" Or br(i) = "新增" Then
ar(r, 1) = i - 1: Exit For
End If
Next i
Next
[J7].Resize(UBound(ar) + 1, 2) = ar
Set dic = Nothing
Application.ScreenUpdating = True
Beep
End Sub
|
|