'变更统计表筛选,通过在C:\人员名单.xlsx文件中筛选出所需要的信息
Function IsExist(mws, name1, name2, team As String) As Boolean
Dim i As Integer
IsExist = False
If name1 = "" Or name2 = "" Then
Exit Function
End If
For i = 3 To mws.UsedRange.Rows.Count Step 1
If mws.Cells(i, 3).Value <> "" And (StrComp(mws.Cells(i, 3).Value, name1, vbTextCompare) = 0 Or StrComp(mws.Cells(i, 3).Value, name2, vbTextCompare) = 0) Then
team = mws.Cells(i, 2).Value
IsExist = True
Exit Function
End If
Next i
End Function
Sub Filter()
Dim ws As Worksheet
Dim mws As Worksheet
Dim name As String
Dim i As Integer
Dim start As Integer
Dim team As String
'人员名单文件位置
name = "C:\人员名单.xlsx"
Set ws = ThisWorkbook.Worksheets(1) '导出变更列表的第一个表格
Set mws = Workbooks.Open(Filename:=name).Worksheets(1)
i = 2
start = ws.UsedRange.Rows.Count + 1
While ws.Cells(i, 1).Value <> ""
If Not IsExist(mws, ws.Cells(i, 7).Value, ws.Cells(i, 8).Value, team) Then
ws.Rows(i).EntireRow.Delete Shift:=xlShiftUp
Else
'Record ws,ws.Cells(i,4).Value,team,start
'ws.Cells(i+50,1).Value = "start:" & start
i = i + 1
End If
Wend
mws.Parent.Close SaveChanges:=False
End Sub