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

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

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

¥»©«³Ì«á¥Ñ mark15jill ©ó 2011-6-8 15:59 ½s¿è

¤§«e ¦³¦b¦¹°Ï µo°Ý¹L ¦hµ§excel·j´M
©Ó»X¦U¦ì¤j¤jªºÁG®q ¦³±o¨ì¹F¨ìµª®×\
¥i¬O ²{¦b²£¥Í¤@­Ó°ÝÃD
¦]·íªì ½d¨Ò¤¤ ªº¦a§} ¥u¦³  ¥xÆW  ©M ¬ü°ê
¥i¬O¤µ¤Ñ¦pªG¦a§}¬O    ¥xÆW¥x¥_ ©ÎªÌ¬O ¬ü°ê¯Ã¬ùªº¸Ü
µ{¦¡·|µLªk§PÂ_¥X¨Ó ¶i¦Ó¥þ³¡ªÅ¥Õ
¤£ª¾¹D¬O§_¦³¤è¦¡¥i¥H¸Ñ¨M

¥H¤U¬O¨º½gªºµ{¦¡½X
  1. Private Sub ¬d¸ß()

  2.     Dim Text$, File$, TheSh As Object, Sh As Worksheet, Rng As Range, RngAddress$

  3.     With ThisWorkbook            'µ{¦¡½X¸m©ó¬d¸ßÁ`ªí.xls

  4.         Set TheSh = .Sheets("¬d¸ß")

  5.         TheSh.UsedRange.Offset(2).Clear

  6.         File = Dir(.Path & "\*¦~«×*.xls")

  7.         Do While File <> ""

  8.         With Workbooks.Open(.Path & "\" & File)

  9.                 For Each Sh In .Sheets

  10.                     Set Rng = Sh.Range("F:F").Find(TheSh.TextBox1, LookAt:=xlWhole)

  11.                     If Not Rng Is Nothing Then

  12.                         RngAddress = Rng.Address

  13.                         With TheSh.Range("C" & Rows.Count).End(xlUp)

  14.                             .Offset(1, -2) = File

  15.                             .Offset(1, -1) = Sh.Name

  16.                         End With

  17.                     End If

  18.                     Do While Not Rng Is Nothing

  19.                         With TheSh.Range("C" & Rows.Count).End(xlUp)

  20.                             .Offset(1).Resize(1, 26) = Sh.Range(Sh.Cells(Rng.Row, "A"), Sh.Cells(Rng.Row, "Z")).Value

  21.                         End With

  22.                         Set Rng = Sh.Range("F:F").FindNext(Rng)

  23.                         If RngAddress = Rng.Address Then Exit Do

  24.                     Loop

  25.                 Next

  26.             .Close 0

  27.             End With

  28.             File = Dir

  29.         Loop

  30.     End With

  31. End Sub
½Æ»s¥N½X
ps ¦A©µ¦ù¤@­Ó°ÝÃD
¦pªG¤µ¤Ñ ­n¥Îoption±±¨î¶µ ¥h±±¨î ¥L©Ò­n·j´MªºÄæ¦ì
¦p µ{¦¡ªº·j´MÄæ¦ì¹w³] F Äæ¦ì
¦ý¬O¤µ¤Ñ¦pªG­n §ï·j´M  DÄæ¦ì
¨º»ò OPTION±±¨î¶µ³o³¡¤À­n«ç³]©w
¦³¸ÕµÛ³]©w ¦ý¬O·|Åܦ¨µLªk§PŪ(§ä¤£¥X¨Ó)

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

TOP

¦^´_ 2# Hsieh


    ª©¤j
§Ú§â¨º¦æµ{¦¡+¦b

                For Each Sh In .Sheets

                    ' ¨ú®ø Set Rng = Sh.Range("F:F").Find(TheSh.TextBox1, LookAt:=xlWhole)

                    Set Rng = Sh.Range("e:e").Find(TheSh.TextBox1)  '-ª©¤jªºµ{¦¡


                    If Not Rng Is Nothing Then


¥i¬O µ²ªGÁÙ¬O¤@¼Ë ªÅ¥Õ

TOP

¥»©«³Ì«á¥Ñ luhpro ©ó 2011-6-8 22:57 ½s¿è
¦pªG¤µ¤Ñ ­n¥Îoption±±¨î¶µ ¥h±±¨î ¥L©Ò­n·j´MªºÄæ¦ì
¦p µ{¦¡ªº·j´MÄæ¦ì¹w³] F Äæ¦ì
¦ý¬O¤µ¤Ñ¦pªG­n §ï·j´M  DÄæ¦ì
¨º»ò OPTION±±¨î¶µ³o³¡¤À­n«ç³]©w
¦³¸ÕµÛ³]©w ¦ý¬O·|Åܦ¨µLªk§PŪ(§ä¤£¥X¨Ó)
mark15jill µoªí©ó 2011-6-8 15:48

¦]¬°¬Ý¤£¨ì§Aªº¹ê¨Ò, ©Ò¥H§Ú²q´ú¨º¥i¯à¬O¦]¬°§A¨S¦³µ¹©wªì­È, ©Î¬O­È¤£¥¿½T,
¥ç©Î¬O¿ï¶µ¼W§R«á·|²£¥Í¨t²Î»~§P(¤£¯à½T©w­þ¨Çºâ¤@²Õ),
¨º»ò§Ú­Ì¥i¥H¦Û¤v±±¨î¹ê»Ú°õ¦æªºµ²ªG.

¥H¤Uµ{¦¡©ñ¦b ThisWorkbook :
Private Sub Workbook_Open()
  obD = True
  obe = False
  obF = False
End Sub

¥H¤Uµ{¦¡ª½±µ¦b³]­p¼Ò¦¡¤UÂùÀ»OptionButton¥H²£¥Í¬ÛÃö¤èªk Sub ÀY§À, ¤¤¶¡©ñ¤W­Ó§O­Èªº³]©wµ{¦¡§Y¥i
Private Sub obD_Click()
  obD = True
  obe = False
  obF = False
End Sub

Private Sub dbE_Click()
  obD = False
  obe = True
  obF = False
End Sub

Private Sub obF_Click()
  obD = False
  obe = False
  obF = True
End Sub

¥u­n§â´¤¨â­Ó­«ÂI :
1. µ{¦¡¶}±Ò®É°O±o³]©w¤@­Ó OptionButton ¬° True, ¨ä¥L«h³]¬° False
2. ·í¨Ï¥ÎªÌÂIÀ»¬Y­Ó OptionButton ®ÉÀ³³y¦¨¸Ó OptionButton ¬° True, ¨ä¥L«h¶·³]¬° False
¥ç§Y¤£ºÞ¨t²Î·|¦Û°Ê§ì¨ú¨ì­þ­Ó,
§Ú­Ì¦Û¤v¨Ó«ü©w§Ú­Ì­n­þ­Ó³Q¿ï¾Ü.

TOP

¦^´_ 4# luhpro


    ©êºp ¬O§Úªº²¨©¿><!!
¦]¬°¦³¸ÕµÛ¥Îif optionbutton1.value = 1 then ªº¤è¦¡¤U¥h ¦ý¬O·|³y¦¨ µ{¦¡µLªk§PŪªº°ÝÃD
¤w¸gªþÀÉ ³o¬O­ì©lªºª©¥»..


¬d¸ß¤ñ¹ï-©µ¦ù°ÝÃD.rar (33.49 KB)

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

¥»©«³Ì«á¥Ñ mark15jill ©ó 2011-6-9 11:21 ½s¿è

¦^´_ 6# Hsieh


    ª©¤j ÁÂÁ ¥i¥H¥Î¤F>< ·P®¦·P®¦
·s¼W¿ï¶µªº°ÝÃD¸Ñ¨M¤F~~
¦ý¬O ÁÙ¬O¤£À´³o¦æªº·N«ä...
nd = IIf(.OptionButton1 = True, 2, IIf(.OptionButton2 = True, 3, IIf(.OptionButton3 = True, 4, IIf(.OptionButton4 = True, 5, IIf(.OptionButton4 = True, 6, 16)))))
Áô¬ùª¾¹D»¡ true,2 ¬O ²Ä¤GÄæ¦ì  ¥i¬O ¬°¤°»ò­n¨º¼Ë¼g?? ¤£À´¤£¸³
¦p true,6,16  ¬O²Ä16­ÓÄæ¦ì  ¦ý¬O 6¬O¬Æ»ò·N«ä

TOP

        ÀR«ä¦Û¦b : ¬°¤H³B¥@­n¤p¤ß²Ó¤ß¡A¦ý¤£­n¡u¤p¤ß²´¡v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD