|
试试行不行吧!{:2012:}
- Sub qc()
- Dim d As Object
- Dim ar, br
- Dim i As Long, j As Long, k As Long
- Set d = CreateObject("scripting.dictionary")
- ar = Sheet1.Cells(1, 1).CurrentRegion
- br = Sheet1.Range("B2:B4")
- For i = 2 To UBound(ar)
- If Not d.exists(ar(i, 1)) Then
- For j = 1 To UBound(br)
- If ar(i, 1) = br(j, 1) Then k = k + 1
- Next j
- If k = 0 Then d.Add ar(i, 1), ""
- k = 0
- End If
- Next i
- With Sheet1.Cells(6, 2)
- .Resize(Rows.Count - 5).ClearContents
- .Resize(d.Count) = Application.Transpose(d.keys)
- End With
- End Sub
复制代码
|
|