Joforn

¦^´_ 1# kasa

1. Sub FindIDByStrComp()
   
2.   Dim lngRow    As Long
   
3.   Dim strFind   As String
   
4.   Dim strValue  As String
   
5.   Dim Range1    As Range
   
6.   
   
7.   With ActiveSheet
   
8.     lngRow = .Range("C" & .Rows.Count).End(xlUp).Row
   
9.     strFind = vbNullChar & Join(Application.WorksheetFunction.Transpose(.Range("C1:C" & lngRow).Value), vbNullChar) & vbNullChar
   
10.     lngRow = .Range("B" & .Rows.Count).End(xlUp).Row
    
11.     For Each Range1 In .Range("B1:B" & lngRow)
    
12.       With Range1
    
13.         .Interior.Pattern = xlNone
    
14.         strValue = vbNullChar & .Value & vbNullChar
    
15.         If Len(strValue) > 2 Then
    
16.           If InStr(strFind, strValue) > 0 Then
    
17.             .Interior.Pattern = xlSolid
    
18.             .Interior.Color = 255&
    
19.           End If
    
20.         End If
    
21.       End With
    
22.     Next
    
23.   End With
    
24. End Sub

½Æ»s¥N½X