查找含有某个字根的字

shiruiqiang

重新更新了一下，引用了ykcbf1100老师的代码，去处b\c列的空格

今铭昔

titi012

参与一下啊。

1. Sub text01()
   
2. 
   
3.     Dim Arr, Brr, Nrr(), T$
   
4.     Dim x&, y&, N&
   
5. 
   
6.     With Sheet1
   
7.         Arr = .Range("B3:C" & .Cells(Rows.Count, 2).End(xlUp).Row).Value
   
8.     End With
   
9. 
   
10.     With Sheet2
    
11.         Brr = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
    
12.         ReDim Nrr(1 To UBound(Brr), 1 To 1)
    
13.         T = .Range("F2").Value
    
14.    
    
15.         For x = 1 To UBound(Arr)
    
16.             If Arr(x, 2) Like "*" & T & "*" Then
    
17.                 For y = 1 To UBound(Brr)
    
18.                     If Brr(y, 1) Like "*" & Arr(x, 1) & "*" Then
    
19.                         N = N + 1
    
20.                         Nrr(N, 1) = Brr(y, 1)
    
21.                         Brr(y, 1) = ""
    
22.                     End If
    
23.                 Next y
    
24.             End If
    
25.         Next x
    
26.    
    
27.         .Range("F3:F99999").Clear
    
28.         .Range("F3").Resize(UBound(Brr), 1) = Nrr
    
29.     End With
    
30. 
    
31. End Sub

复制代码

abc0931

今铭昔老师的文件也下载下来学习了，深表感谢！