Hsieh

¦^´_ 1# papaya

1. Private Sub CommandButton1_Click()
   
2. Dim MyRng As Range, MyRng1 As Range
   
3. k = [B2]
   
4. a = [C2]
   
5. Set Rng = Columns("D").Find(k, lookat:=xlWhole)
   
6. mystr = Join(Application.Transpose(Application.Transpose(Rng.Offset(, 1).Resize(, 4))), "")
   
7. s = InStr(mystr, a)
   
8. If s = 0 Then MsgBox "¦¹¦CµL¦¹¥Í¨v": End
   
9. t = Mid(Join(Application.Transpose(Application.Transpose(Rng.Offset(, 6).Resize(, 4))), ""), s, 1)
   
10. For Each c In Range([D2], [D2].End(xlDown))
    
11.    Set n = c.Offset(, 1).Resize(, 4).Find(a, lookat:=xlWhole)
    
12.    Set m = c.Offset(, 6).Resize(, 4).Find(t, lookat:=xlWhole)
    
13.    If Not n Is Nothing And Not m Is Nothing Then
    
14.       cnt = cnt + 1
    
15.       If MyRng Is Nothing Then
    
16.       Set MyRng = n
    
17.       Set MyRng1 = m
    
18.       Else
    
19.       Set MyRng = Union(MyRng, n)
    
20.       Set MyRng1 = Union(MyRng1, m)
    
21.       End If
    
22.    End If
    
23. Next
    
24. MsgBox cnt & "¦¸"
    
25. If cnt > 1 Then
    
26.   MyRng.Interior.ColorIndex = 6
    
27.   MyRng1.Interior.ColorIndex = 8
    
28. End If
    
29. End Sub

½Æ»s¥N½X