常用脚本--Excel中筛选出所需要的信息

'变更统计表筛选,通过在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