[已解决]求个VBA

hwc2ycy

如果用的10，直接用10自带的去重复值。

1. Sub tsst()
   
2.     Dim arr, a, j As Byte, k As Byte
   
3.     Dim arrCon
   
4.     Dim arrA(1 To 65536, 1 To 1), lPos As Integer
   
5.    
   
6.     arr = ActiveSheet.UsedRange.Columns(2).Value
   
7.     arrCon = Range(Range("c3"), Range("c3").End(xlToRight)).Value
   
8.    
   
9.     For i = LBound(arrCon, 2) To UBound(arrCon, 2)
   
10.         arrCon(1, i) = Trim(arrCon(1, i))
    
11.     Next
    
12. 
    
13.     For Each a In arr
    
14.         If Len(a) Then
    
15.             For Each b In arrCon
    
16.                 k = 0
    
17.                 For j = 1 To Len(a)
    
18.                     If InStr(b, Mid(a, j, 1)) Then k = k + 1
    
19.                     If j = 2 And k = 0 Then Exit For
    
20.                 Next
    
21.                 If k > 1 Then
    
22.                     lPos = lPos + 1
    
23.                     arrA(lPos, 1) = "'" & a
    
24.                 End If
    
25.             Next
    
26.         End If
    
27.     Next
    
28.    
    
29.     If lPos Then
    
30.         With Columns(1)
    
31.             .Clear
    
32.             .Cells(1, 1).Resize(lPos).Value = arrA
    
33.             .RemoveDuplicates Columns:=1, Header:=xlNo
    
34.         End With
    
35.         MsgBox "完成"
    
36.     End If
    
37. End Sub

复制代码