- Sub 筛选()
- Dim arr, brr, i, j, r, s, d
- Set d = CreateObject("scripting.dictionary")
- With Sheet4
- arr = .UsedRange
- For i = 2 To UBound(arr)
- For j = 1 To UBound(arr, 2) Step 2
- If arr(i, j) <> "" Then
- sa = arr(i, j)
- d(sa) = ""
- End If
- Next
- Next
- End With
- With Sheet2
- r = .Cells(Rows.Count, 1).End(xlUp).Row
- c = .Cells(1, Columns.Count).End(xlToLeft).Column
- arr = .Range("a1").Resize(r, c)
- End With
- ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
- For i = 2 To UBound(arr)
- sb = arr(i, 18)
- sc = arr(i, 11)
- If sc <> Empty Then
- arr(i, 24) = "Y"
- End If
- If d.exists(sb) Then
- n = n + 1
- For j = 1 To UBound(arr, 2)
- brr(n, j) = arr(i, j)
- Next
- End If
- If d.exists(sc) Then
- n = n + 1
- For j = 1 To UBound(arr, 2)
- brr(n, j) = arr(i, j)
- Next
- End If
- Next
- Sheet2.[a1].Resize(r, 24) = arr
- Sheet1.[a5].Resize(n, 24) = brr
- End Sub
复制代码 |