|
Sub bnf()
Dim h As Long
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
For h = [a65536].End(3).Row To 2 Step -1
qh = hs(h)
For n = Cells(qh, 2) To Cells(qh, 3)
d(Trim(Str(n))) = 1
Next n
For Each n In d.keys
Set qn = Range(Cells(qh, 4), Cells(h, 4)).Find(n)
If qn Is Nothing Then
Rows(h + 1).Insert xlShiftDown
Cells(h + 1, 1) = Cells(qh, 1): Cells(h + 1, 1).Offset(0, 4) = "'" & n
End If
Next n
d.RemoveAll
h = h - (h - qh)
Next h
For h = 2 To [a65536].End(3).Row
If Cells(h, 4) <> "" Then Cells(h, 5) = "'" & Cells(h, 4)
Next h
Range("a1:e" & [a65536].End(3).Row).Sort key1:="姓名", key2:="缺失时间", Header:=xlYes
For h = 2 To [a65536].End(3).Row
If Cells(h, 4) = "" Then
Cells(h, 1) = ""
Else
Cells(h, 5) = ""
End If
Next h
Application.ScreenUpdating = True
End Sub
Function hs(h As Long) As Long
For i = h To 1 Step -1
If Cells(i, 2) <> Cells(i - 1, 2) Then Exit For
Next
hs = i
End Function
|
|