Hsieh

Set Rng = Sh.Range("D:D").Find(TheSh.TextBox1)
§ï¦¨DÄæ¼Ò½k·j´M

Hsieh

¦^´_ 5# mark15jill

1. Sub ex()
   
2. Dim Ar()
   
3. Application.ScreenUpdating = False
   
4. With Sheet1
   
5. nd = IIf(.OptionButton1 = True, 2, IIf(.OptionButton2 = True, 5, 0))
   
6. mystr = "*" & .TextBox1 & "*"
   
7. If nd = 0 Then MsgBox "½Ð¿ï¾Ü¬d¸ß¶µ¥Ø": Exit Sub
   
8. fs = Dir(ThisWorkbook.Path & "\*¦~«×.xls")
   
9. Do Until fs = ""
   
10.    With Workbooks.Open(ThisWorkbook.Path & "\" & fs)
    
11.      For Each Sh In .Sheets
    
12.      With Sh
    
13.      If Application.CountA(.Columns(nd)) = 0 Then GoTo 10
    
14.         For Each a In .Columns(nd).SpecialCells(xlCellTypeConstants)
    
15.         If a Like mystr Then
    
16.            ReDim Preserve Ar(s)
    
17.            Ar(s) = Array(fs, .Name, s + 1, .Cells(a.Row, 2).Value, .Cells(a.Row, 4).Value, .Cells(a.Row, 1).Value, .Cells(a.Row, 5).Value)
    
18.            s = s + 1
    
19.         End If
    
20.         Next
    
21. 10
    
22.      End With
    
23.      Next
    
24.     .Close 0
    
25.    End With
    
26.    fs = Dir
    
27. Loop
    
28. If s > 0 Then
    
29. .[A3:G65536] = ""
    
30. .[A3].Resize(s, 7) = Application.Transpose(Application.Transpose(Ar))
    
31. Else
    
32. MsgBox "¬dµL¸ê®Æ"
    
33. End If
    
34. End With
    
35. Application.ScreenUpdating = True
    
36. End Sub

½Æ»s¥N½X