ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¦hµ§EXCEL·j´Mªº¥Îªk-©µ¦ù°ÝÃD

Set Rng = Sh.Range("D:D").Find(TheSh.TextBox1)
§ï¦¨DÄæ¼Ò½k·j´M
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¥»©«³Ì«á¥Ñ Hsieh ©ó 2011-6-9 08:51 ½s¿è

¦^´_ 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
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

        ÀR«ä¦Û¦b : ­n§åµû§O¤H®É¡A¥ý·Q·Q¦Û¤v¬O§_§¹¬üµL¯Ê¡C
ªð¦^¦Cªí ¤W¤@¥DÃD