|
发表于 2011-11-20 21:04
|
显示全部楼层
本楼为最佳答案
引入数组,肯定快多了:- Sub 查找客户()
- ARR = Range("A2:B" & Range("A65536").End(xlUp).Row)
- BRR = Range("C2:E" & Range("E65536").End(xlUp).Row)
- ReDim CRR(1 To UBound(ARR))
- For M = 1 To UBound(BRR)
- For I = 1 To UBound(ARR)
- If ARR(I, 2) <> 1 Then
- If InStr(ARR(I, 1), BRR(M, 2)) > 0 And InStr(ARR(I, 1), BRR(M, 3)) > 0 And BRR(M, 1) = "" Then
- BRR(M, 1) = ARR(I, 1)
- ARR(I, 2) = 1
- Exit For
- End If
- End If
- Next I
- Next M
- For I = 1 To UBound(ARR)
- If ARR(I, 2) <> 1 Then
- T = T + 1
- CRR(T) = ARR(I, 1)
- End If
- Next
- Range("A2:B" & Range("A65536").End(xlUp).Row).ClearContents
- Range("C2:E" & Range("E65536").End(xlUp).Row).ClearContents
- Range("A2").Resize(T, 1) = Application.Transpose(CRR)
- Range("C2").Resize(UBound(BRR), 3) = BRR
- End Sub
复制代码 |
|