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

[µo°Ý] ¥i§_¥Î°j°é©ÎÅܼƶפJ¤j¶q¸ê®Æ¡H

¦^´_ 40# GBKEE
ª©¥D±z¦n¡A­è­è±N¹q¸£Ãö³¬«á­«·s¶}±Ò«á¦A­«·s°õ¦æVBA¡Aµ²ªG«Ü¤£¿ù¡A¤@­Ó¥­§¡¤@¬í¦h¡A¥i¯à¤§«e§Ú¦b°õ¦æVBA®É¶}±Ò¤Ó¦h¨ä¥L³nÅé¤F

³o­Ó¬OÂ^¨ú¦~¦¨¥æ¸ê°T¡AÁÙ¦³¤@­Ó¤ë¦¨¥æ¸ê°T¡A¦]¬°¤ë¦¨¥æ¸ê°T¬O­nÂI¤ë¥÷¨Ó¿ï¾Ü¡A§Ú·|¥ý¦Û¤v°µ¬Ý¬Ý¡A¤£¦æªº¸Ü·|¦A¨Ó¦V±z°Q±Ð
¥t¥~±zªþ¤Wªº¶°«O¸ê®Æ§ÚÁÙ¨S¸Õ¡A±ß¤W·|§Q¥Î®É¶¡¨Ó¸Õ¸Õ¡A¤£¹L§Ú¦³µy·LºË¤F¤@¤U¡A¦³¬Ý¨ìINPUT BOX¡A¦]¬°§Ú¬O­n¥Î°j°é³sÄòÂ^¨ú¸ê®Æ
¤£¬O­n¥ÎINPUT BOX¿é¤J¥N½X¨ÓÂ^¨ú¸ê®Æ¡A¤]¤£»Ý­nªþÀɪº¹Ï¡A¥u»Ý­n¤å¦rÀɤº®e§Y¡A¤£ª¾¹D§Ú¬O§_¸ÑŪ¿ù»~¡A·|§Q¥Î®É¶¡¤F¸Ñ¬Ý¬Ý¡A¦A¦¸·PÁ±z¡I

TOP

¦^´_ 38# GBKEE
GBKEEª©¥D¦­¦w¡A§Ú¦b§ì¤W¥«­ÓªÑ¦~¦¨¥æ¸ê°T¤S¹J¨ì°ÝÃD¤F¡A­ì¥»¬O·Q§Q¥Î±z¦b37#ªº§ì¨ú¤WÂd¦~¦¨¥æªºµ{¦¡½X¨Ó­×§ï¡A¦ý«o¥X¿ù¡A¯à½Ð±z¦AÀ°¦£¬Ý¤@¤U¶Ü¡H
¥t¥~¦]¬°§Æ±æ±N¶×¤J¸ê®ÆªºEXCELªí®æ°µ¤@¨Ç­×§ï¦A¦s¤Jtxt¡A©Ò¥H§Ú¤]¦³¥Î¥ý«e§ì¨ä¥L¸ê®ÆªºVBA¨Ó´ú¸Õ¡A¦ý¦]¬°¥ý«e³sµ²ªººô¯¸¬O°ê®õÃÒ¨é¡A»Ý­nªº¸ê®Æ¥u­n±N
³Ì«áªº­ÓªÑ¥N½X³]©w¦¨°j°éÅܼơA´N¯à±N¸ê®Æ¤@­Ó¤@­ÓÂ^¨ú¤U¨Ó¡A¦ý¤W¥«¦~¦¨¥æ¸ê°Tªººô­¶¤£¬O³o¼Ëªº®æ¦¡¡A©Ò¥H¤£²M·¡¸Ó«ç»ò°µ°j°é³]©wÂ^¨ú¸ê°T
½Ð±z¦A«üÂI¤@¤U¡A¦pªG¥i¥Hªº¸Ü¡A§Æ±æ¨âºØ³£¯à¾Ç¡Aªþ¤W¨â­ÓEXCEL VBA¥H¤Î³sµ²ªº¸ê°T
test.zip (37.88 KB)

"URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCC/ZCC.DJHTM?A=2330"    >>>>>>>>>³o¬O¥ý«e§Q¥Î°ê®õÃҨ鰵ªº³sµ²ºô§}¡A¥u­n±N³Ì«á§ï¦¨°j°éÅܼƴN¥i¥H¤F

"URL;http://www.twse.com.tw/ch/trading/exchange/FMNPTK/genpage/Report201404/2330_F3_1_11.php?STK_NO=2330&myear=2014&mmon=04"
³o¬OÃÒ¥æ©Ò¤W¥«­ÓªÑ2330ªº¦~¦¨¥æ¸ê°T³sµ²¡A¤£ª¾¹D¦³¨S¦³¿ìªk¥Î°j°éÅܼưµ³sµ²

"URL;http://www.twse.com.tw/ch/trading/exchange/FMNPTK/FMNPTKMAIN.php"      >>>>>>>>>>>>>>³o¬OÃÒ¥æ©Ò¤W¥«­ÓªÑ¦~¦¨¥æ¸ê°T­º­¶


³o±i¹Ï´N¬O·Q­n§ìªºªí®æ¡A¤W­±¦³´£¨ì§Æ±æ¯à¥ý¶×¨ìEXCEL¦A¦s¨ì¤å¦rÀÉ´N¬O§Æ±æ¦~ªº¶¶§Ç¥i¥H¤Ï¹L¨Ó¡A¤]´N¬O¶V·sªº¦~«×±Æ¶V¤W­±¡A¥t¥~¸ê®Æ¦b¶×¤JEXCEL«á·|±N
(¤¸,ªÑ)¤]Åܦ¨¤@¦C¡A³o¤@¦C¤]§Æ±æ¯à§R°£

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-4-30 10:30 ½s¿è

¦^´_ 42# smart3135
WEB ¬d¸ß½Ð ª©¤W¦³³\¦h°Q½× ¥i·j´M http://www.twse.com.tw/ch/trading/exchange/FMNPTK/FMNPTKMAIN.php  ³o¦r¦ê
¤W¥«»P ¤WÂd ºô­¶ªº«Ø¸m¤£¦P
  1. Option Explicit
  2. Dim IE As Object
  3. Sub IE_Application()
  4.     Set IE = CreateObject("InternetExplorer.Application")
  5.     With IE
  6.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/FMNPTK/FMNPTKMAIN.php"
  7.         .Visible = True   'Åã¥Üie
  8.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  9.   End With
  10. End Sub
  11. Sub ¤W¥«¦~¦¨¥æ¸ê°T()
  12.     Dim E As Range, xPath As String, xFile As String, A As Object, fs As Object, F As Object, IE_URL As String
  13.     Dim i As Integer, ii As Integer, t As Date, AR(), Rng As Range, r, C, S
  14.     Set fs = CreateObject("Scripting.FileSystemObject")
  15.     IE_URL = "http://www.twse.com.tw/ch/trading/exchange/FMNPTK/FMNPTKMAIN.php"
  16.     t = Time
  17.     Application.DisplayStatusBar = True
  18.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  19.     If Application.Count(Rng) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  20.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  21.     '§A¤w±N¤W¥«ªºªÑ²¼¥N¸¹,¦bSheets(3).Range("A1")©¹¤UKey¤W,°j°é¨Ì³o¸ÌªºªÑ²¼¥N¸¹¶×¤J
  22.     xPath = "D:\°]³ø¸ê®Æ"
  23.     IE_Application    '
  24.     Application.StatusBar = " "
  25.     Sheets(1).Activate
  26.     For Each E In Rng
  27.         With IE
  28.             Do While .Busy Or .ReadyState <> 4:    Loop
  29.             Set A = .Document.getelementbyid("STK_NO")
  30.             A.Value = E
  31.              .Document.getelementSbyNAME("login_btn")(0).Click  '«ö¤U¬d¸ß
  32.             Do While .Busy Or .ReadyState <> 4:    Loop
  33.             Set A = .Document.getelementsbytagname("TABLE")
  34.             xFile = xPath & "\" & E & "\HPM.txt"
  35.             MkDir_Sub xFile
  36.              With Sheets(1)
  37.                 .Cells.Clear
  38.                 For i = 1 To A(7).Rows.Length - 1
  39.                     For C = 0 To A(7).Rows(i).Cells.Length - 1
  40.                     .Cells(i, C + 1) = A(7).Rows(i).Cells(C).innertext
  41.                     Next
  42.                 Next
  43.                 .UsedRange.Sort Key1:=.Range("A2"), Order1:=xlDescending, Header:=True  '±Æ§Ç:xlDescending ( ¥Ñ¤j¦Ü¤p )
  44.                 Maketxt xFile, .UsedRange
  45.             End With
  46.             ii = ii + 1
  47.         End With
  48.         Application.StatusBar = Application.Text(Time - t, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤W¥«¦~¦¨¥æ " & ii & " ¤å¦rÀÉ"
  49.     Next
  50.     IE.Quit
  51.     Application.StatusBar = Application.Text(Time - t, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤W¥«¦~¦¨¥æ " & ii & " ¤å¦rÀÉ,  Åª¨ú§¹²¦ !! "
  52.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.Text(Time - t, ["MM¤ÀSS¬í"])
  53.     ThisWorkbook.Save
  54. End Sub
  55. Sub Maketxt(xF As String, Q As Range)   '***   Q As Range  ****
  56.     Dim fs As Object, E As Range, C As Variant
  57.     Set fs = CreateObject("Scripting.FileSystemObject")
  58.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  59.     For Each E In Q.Rows   '­×§ï³o  Q.ResultRange.Rows
  60.     C = Application.Transpose(Application.Transpose(E.Value))
  61.         C = Join(C, vbTab)
  62.         fs.WriteLine C
  63.     Next
  64.     fs.Close
  65. End Sub
  66. Sub MkDir_Sub(S As String)
  67.     Dim AR, i As Integer, xPath As String
  68.     If Dir(S) = "" Then
  69.         AR = Split(S, "\")
  70.         xPath = AR(0)
  71.         For i = 1 To UBound(AR) - 1
  72.             xPath = xPath & "\" & AR(i)
  73.             If Dir(xPath, vbDirectory) = "" Then MkDir xPath
  74.         Next
  75.     End If
  76. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 43# GBKEE
¤£¦n·N«ä¡AGBKEEª©¥D¡A½Ð°Ý¬O·j´M http://www.twse.com.tw/ch/trading/exchange/FMNPTK/FMNPTKMAIN.php³o¦r¦ê¶Ü¡H
¦]¬°§Ú¦bª©¤W·j¯Á³o¦r¦ê¬O¬dµLµ²ªGªº¡A©Ò¥H·Q¸ò±z½T»{¤@¤U¡A§Ú¤]·Q¦n¦n¾Ç²ßºô­¶«Ø¸m¤£¦P¤Wªº®t§O¦b­þ¡HÁÂÁ±z¡I

TOP

¦^´_ 43# GBKEE
«¢Åo¡IGBKEEª©¥D¡A¤S¨Ó¦V±z°Q±ÐÅo¡IÃö©ó¦b43#ªºµ{¦¡½X¦bsheet(3)ªºAÄæ®M¥Î¤W¥«­ÓªÑ¥N¸¹«á¬O¥i¦æªº¡A¦ý­Y§Ú·Q±Nºô§}§ï¦¨¤ë¦¨¥æ¸ê°T
·|¦h¤F¤@­Ó"¦~"¬d¸ßÄæ¡A¤S¸Ó¦p¦ó³]©w"¦~"ªº¬d¸ßÄæ¦ì¥i¥H¦h¬d´X¦~©O¡H¨Ò¦p­º­¶¬Oª½±µ¸õ¥X103¦~¡A¦A¿é¤JªÑ²¼¥N½X§Y¥i¬d¸ß¡A§Ú·Q±N102¦~¡B101¦~ªº¸ê®Æ
¤]¤@°_¶×¤J¡AÀ³¸Ó«ç»ò°µÅܤƩO¡H§Ú·QÃöÁä¬O¤£¬O¦b¥H¤Uªºµ{¦¡½X¡A¦]¬°¹ï¤º®eªº»yªk¤£¤Ó¤F¸Ñ¡A©Ò¥H·Q¦A¨Ó½Ð±Ð±z¤@¤U¡I
§Ú­Yª½±µ±N¤ë¦¨¥æ¸ê°Tªººô§}±a¤J¡A¥u¯à¶×¤J103¦~ªº¸ê®Æ¡A¤£ª¾¹D¬O¤£¬O¦U¦~«×ªº¤ë¦¨¥æ¸ê°T¯à¹³ªÑ²¼¥N½X¤@¼Ë¦bsheet(3)ªº¬YÄæ¦ì¿é¤J·í¦¨°j°é
´N¯à¶×¤J»Ý­nªº¸ê®Æ¡A¨Ò¦p§Ú·Q­n103¡B102¡B101¡B100¦~ªº¤ë¦¨¥æ¸ê°T¡A´N¦bsheet(3)ªºBÄæ±q¤W©¹¤Ukey¤J¡A¦A°µ¤@¨Çµ{¦¡½XªºÅܧó´N¯àÅýµ{¦¡¥h¨Ì·Ó
sheet(3)ªºBÄæ¿é¤Jªº¦~¥÷¶×¤J¤ë¦¨¥æ¸ê°T¡A¤£ª¾³o¼Ëªº·Qªk¹ï¤£¹ï¡A¦A½Ð±z«üÂI¤@µf¡IÁÂÁ¡I
¡@¡@¡@Do While .Busy Or .ReadyState <> 4:    Loop
            Set A = .Document.getelementbyid("STK_NO")
            A.Value = E
             .Document.getelementSbyNAME("login_btn")(0).Click  '«ö¤U¬d¸ß
            Do While .Busy Or .ReadyState <> 4:    Loop
            Set A = .Document.getelementsbytagname("TABLE")


¤WÂd¤ë¦¨¥æ¸ê°T





¤W¥«¤ë¦¨¥æ¸ê°T

TOP

¦^´_ 38# GBKEE
GBKEEª©¥D±z¦n¡A¤S¨Ó¦V±z°Q±Ð¤F¡A¦]¬°¥ý«e¤£À´¬°¤°»ò¬d¸ß¤W¥«»P¤WÂd¦~¦¨¥æ¸ê°TªºVBAµ{¦¡½X¤¤¤À§O¦³"STK_NO"»P"input stock code"¡A¤§«á¤~·Q¨ì¬O­n¥h§äºô­¶­ìÖí½X
ÁöµM¤j³¡¤À³£¬Ý¤£À´¡A¤£¹L½T¹ê¬O¤À§O¦b¤W¥«»P¤WÂd¦~¦¨¥æ¸ê°Tªººô­¶­ì©l½X¤¤§ä¨ì¤W­z¨â­Ó¦r¦ê¡A§Ú·Q³oÀ³¸Ó¬O¥²©w­n¼g¦bVBA¤¤ªºÃöÁä¦r¦ê¡A«á¨Ó¥h¬d¤F¤@¤U¤WÂdªº¤ë¦¨¥æ¸ê°T
¦³¬Ý¨ì¦h¥X¤é´ÁÄ檺¦r¦ê¡A´ú¸Õ¤F±N¦r¦ê¼g¤JVBA¡A¦ý«o·|¥X¿ù¡A¹Á¸Õ¦h¦¸Åܧ󤴵Lªk¶¶§Q°õ¦æ¡A¤£ª¾¸Ó¦p¦ó±N³o¨Ç¦r¦ê¥¿½T¦a¼g¤JVBA¡A·íµM¤W¥«ªº¤ë¦¨¥æ¸ê°T
´ú¸Õµ²ªG¤]©M¤WÂdªº¤@¼Ë¡A³£¬OµL¥\¦Óªð¡A©Ò¥H¥u¯à¦A«×¥oÂZ±z¤F¡AÀµ½Ð±z¦A¦¸½ç±Ð¡A·PÁ¡I
test.zip (17.84 KB)

¤WÂd¦~¦¨¥æ¸ê°T


¤WÂd¤ë¦¨¥æ¸ê°T

TOP

¦^´_ 46# smart3135
  1. For Each E In Rng
  2.         For Each X In Rng1
  3.             With IE
  4.          'http://forum.twbts.com/viewthread.php?tid=8111  chrom ¤¤¥i¬d¬Ý¤¸¯Àªºµ²ºc
  5.          '<select name="yy" class="input-select ui-corner-all" id="y_date1" onchange="query()">
  6.          '<option value="1996">85</option><option value="1997">86</option><option value="1998">87</option>         
  7.                 Set B = .document.getelementsbytagname("select")("YY")
  8.                 B.Value = X
  9.                 Set A = .document.getelementbyid("input_stock_code")
  10.                 A.Value = E
  11.    
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 47# GBKEE
·PÁª©¥D­@¤ßªº¦^µª¡A¬Ý¤F¤å³¹¤§«á¡A¤j·§¤F¸Ñ¤F¬Û¹ï¤Þ¼ÆªºÃöÁä¦r¡A¤]¦³¸ÕµÛ±N¬Û¹ï¤Þ¼Æ"select"©M"yy"¥N¤J¡Aµ²ªG¬O¥i¦æªº
¤£¹L¦³ÂI°ÝÃD¡G
1.¦b°j°é°õ¦æµ{¦¡®É¬O·|¨Ì·Ó§Ú¦bsheet(3) BÄæ¿é¤Jªº¦~¥÷¶×¤J¤å¦rÀÉ¡A¤£¹L¤U¤@¦~¥÷ªº¸ê®Æ¤S·|Âл\­ì¨Óªº¤å¦rÀɤº®e
    ¨Ò¦p§Ú¦bsheet(3) BÄæ¿é¤Jªº¦~¥÷¬O2014¡B2013¡B2012¡Aµ²ªG2014ªº¼g§¹«á¦A¼g¤U¤@µ§ªº2013´N·|§â­ì¨Ó¼g¤Jªº2014Âл\±¼
    ¤£ª¾¹D¯à¤£¯à±N¤T¦~ªº¸ê®Æ³£¼g¤J¤å¦rÀÉ¡H
2.¦~¥÷°j°é¬O§_¥u¯à§Q¥Î¹³­ÓªÑ¥N¸¹¤@¼Ë¦bsheet(3) ¬YÄæ¿é¤J·Q­nÂ^¨úªº¦~¥÷¸ê®Æ¡A¯à¤£¯àª½±µ¼g¤JVBA¤¤©O¡H
3.¼g¤Jªº¤å¦rÀɬO±q¶}©l¦³¼Æ¦r¸ê®Æ®É¼g°_¡A¤£ª¾¹D¯à¤£¯à¥Ñ³Ì¤W¤è­ÓªÑ¥N¸¹¨º¤@¦C¶}©l¼g¤J¡A¤]´N¬O¤å¦rÀɤ¤·|¬Ý±o¨ì­ÓªÑ¥N¸¹
4.¦]¬°³o­ÓVBAµ{¦¡¬Oª½±µ±N¸ê®Æ¼g¤J¤å¦rÀÉ¡AµLªk¬Ý¨ì¸ê®Æ¶×¤JEXCELªº°Ê§@¡A¤£ª¾¹D¯à¤£¯à°µ¤é´Á±Æ§Ç
    ¨Ò¦p¼g¤Jªº²Ä¤@¦~¥÷¸ê®Æ¥Ñ¤W¨ì¤U¬O103¦~1¤ë¥÷¨ì103¦~5¤ë¥÷¡A¤£ª¾¹D¯à¤£¯à±N5¤ë¥÷¼g¨ì³Ì¤W¤è
§Ú·Q°ÝÃD·|³o»ò¦h¡AÀ³¸Ó¬O§ÚVBA°ò¦ÁÙ¨S¥´¦n´N«æ©ó¾Ç²ß§ó¶i¶¥ªºªF¦è¡A¬Ý¨Ó§Ú¥i¯à±o¦h¬Ý¨Ç®Ñ¡B¤å³¹¡B¼v¤ù¥R¹ê¦Û¤vªºVBA°ò¦¡A«Ü·PÁª©¥D³s¤é¨Ó¤£¹½¨ä·Ðªº¦^µª¡I

  1. Option Explicit
  2. Dim IE As Object
  3. Sub IE_Application()
  4.     Set IE = CreateObject("InternetExplorer.Application")
  5.     With IE
  6.         .Navigate "http://www.gretai.org.tw/ch/stock/statistics/monthly/st44.php"
  7.      '   .Visible = True   '¤£Åã¥Üie
  8.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  9.   End With
  10. End Sub
  11. Sub ¤WÂd¤ë¦¨¥æ¸ê°T()
  12.     Dim E, X As Range, xPath As String, xFile As String, A, B As Object, fs As Object, F As Object, IE_URL As String
  13.     Dim i As Integer, ii As Integer, t As Date, AR(), Rng, Rng1 As Range, r, C, S
  14.     Set fs = CreateObject("Scripting.FileSystemObject")
  15.     IE_URL = "http://www.gretai.org.tw/ch/stock/statistics/monthly/st44.php"
  16.     t = Time
  17.     Application.DisplayStatusBar = True
  18.     '½Ð±N¤WÂdªºªÑ²¼¥N¸¹,¦b Sheets(3).Range("A1")©¹¤UKey¤W,°j°é¨Ì³o¸ÌªºªÑ²¼¥N¸¹¶×¤J
  19.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  20.     Set Rng1 = ThisWorkbook.Sheets(3).Range("b:b")
  21.     If Application.Count(Rng) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  22.     If Application.Count(Rng1) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  23.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  24.     Set Rng1 = Rng1.SpecialCells(xlCellTypeConstants)
  25.     xPath = "D:\°]³ø¸ê®Æ"
  26.     IE_Application    '
  27.     Application.StatusBar = " "
  28.     For Each E In Rng
  29.         For Each X In Rng1
  30.             With IE
  31.                 Set B = .document.getelementsbytagname("select")("yy")
  32.                 B.Value = X
  33.                 Set A = .document.getelementbyid("input_stock_code")
  34.                 A.Value = E
  35.                 A.ParentNode.submit
  36.                 Do While .Busy Or .ReadyState <> 4:    Loop
  37.                 Set A = .document.getelementsbytagname("TABLE")
  38.                 xFile = xPath & "\" & E & "\HPM.txt"
  39.                 MkDir_Sub xFile
  40.                 With fs.CreateTextFile(xFile, True)
  41.                     For i = 1 To A(2).Rows.Length - 1
  42.                         S = ""
  43.                         For C = 0 To A(2).Rows(i).Cells.Length - 1
  44.                             S = S & A(2).Rows(i).Cells(C).innertext & vbTab
  45.                         Next C
  46.                         .WriteLine S
  47.                     Next i
  48.                     .Close
  49.                 End With
  50.             ii = ii + 1
  51.             End With
  52.         Application.StatusBar = Application.Text(Time - t, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ"
  53.         Next X
  54.     Next E
  55.     IE.Quit
  56.     Application.StatusBar = Application.Text(Time - t, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ,  Åª¨ú§¹²¦ !! "
  57.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.Text(Time - t, ["MM¤ÀSS¬í"])
  58.     ThisWorkbook.Save
  59. End Sub
  60. Sub MkDir_Sub(S As String)
  61.     Dim AR, i As Integer, xPath As String
  62.     If Dir(S) = "" Then
  63.         AR = Split(S, "\")
  64.         xPath = AR(0)
  65.         For i = 1 To UBound(AR) - 1
  66.             xPath = xPath & "\" & AR(i)
  67.             If Dir(xPath, vbDirectory) = "" Then MkDir xPath
  68.         Next
  69.     End If
  70. End Sub
  71. Sub Maketxt(xF As String, Q As QueryTable)   '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  72.     Dim fs As Object, E As Range, C As Variant
  73.     Set fs = CreateObject("Scripting.FileSystemObject")
  74.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  75.     For Each E In Q.ResultRange.Rows
  76.         C = Application.Transpose(Application.Transpose(E.Value))
  77.         C = Join(C, vbTab)
  78.         fs.WriteLine C
  79.     Next
  80.     fs.Close
  81. End Sub
½Æ»s¥N½X
test2.zip (17.73 KB)

TOP

¦^´_ 48# smart3135
  1. Option Explicit
  2. Dim IE As Object
  3. Sub IE_Application()
  4.     Set IE = CreateObject("InternetExplorer.Application")
  5.     With IE
  6.         .Navigate "http://www.gretai.org.tw/ch/stock/statistics/monthly/st44.php"
  7.         .Visible = True   '¤£Åã¥Üie
  8.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  9.   End With
  10. End Sub
  11. Sub ¤WÂd¤ë¦¨¥æ¸ê°T()
  12.     Dim Rng As Range, Rng1 As Range, E As Range, X As Range, T As Date, xPath As String, xFile As String
  13.     Dim Ea As Variant, ar(), ii As Integer
  14.     T = Time
  15.     Application.DisplayStatusBar = True
  16.     '½Ð±N¤WÂdªºªÑ²¼¥N¸¹,¦b Sheets(3).Range("A1")©¹¤UKey¤W,°j°é¨Ì³o¸ÌªºªÑ²¼¥N¸¹¶×¤J
  17.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  18.     Set Rng1 = ThisWorkbook.Sheets(3).Range("b:b")
  19.     If Application.Count(Rng) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  20.     If Application.Count(Rng1) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  21.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  22.     Set Rng1 = Rng1.SpecialCells(xlCellTypeConstants)
  23.     xPath = "G:\°]³ø¸ê®Æ"
  24.     IE_Application    '
  25.     Application.StatusBar = " "
  26.     For Each E In Rng
  27.         Sheets(1).UsedRange.Clear  '¤U¸ü¸ê®Æ¸m©ó¦¹¤u§@ªí,ÅÜ´«ªÑ²¼®É:²MªÅ
  28.         For Each X In Rng1
  29.             With IE
  30.                 .document.getElementsByTagName("select")("yy").Value = X
  31.                  With .document.getelementbyid("input_stock_code")
  32.                     .Value = E
  33.                     .ParentNode.submit
  34.                 End With
  35.                 Do While .Busy Or .readyState <> 4:    Loop
  36.                 If Application.Count(Sheets(1).UsedRange) = 0 Then '¦¹¤u§@ªí²MªÅ®É:¤U¸ü²Ä¤@¦~«×®É
  37.                     ar = Array(0, 2)
  38.                 Else
  39.                     ar = Array(2)
  40.                 End If
  41.                 For Each Ea In ar
  42.                     Ep .document.getElementsByTagName("TABLE")(Ea).outerHTML
  43.                 Next
  44.             ii = ii + 1
  45.             End With
  46.         Next X
  47.         xFile = xPath & "\" & E & "\HPM.txt"
  48.         MkDir_Sub xFile
  49.         Maketxt xFile, Sheets(1).UsedRange
  50.         Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ"
  51.     Next E
  52.     IE.Quit
  53.     Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ,  Åª¨ú§¹²¦ !! "
  54.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.Text(Time - T, ["MM¤ÀSS¬í"])
  55.     ThisWorkbook.Save
  56. End Sub
  57. Sub Ep(S As String)
  58.     Dim D As New DataObject, E As Shape, FormDLL As String
  59.     'DataObject ª«¥ó ¦b¶i¦æÂà´«°Ê§@®É¡A°µ¬°®æ¦¡¤Æ¤å¦r¸ê®Æªº¼È¦s°Ï°ì¡C¨ä¤]¥i¥H¼È¦s©MÀx¦s¦b DataObject ªº¤å¦r¤ù¬q¬ÛÃöªº®æ¦¡¡C
  60.     '«Å§i Dim D As New DataObject '¶·¦b¤u¨ã-> ³]©w¤Þ¥Î¶µ¥Ø¥[¤J ·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library ,±M®× ¥[¤J¤@ªí³æ§Y¥i
  61.     On Error GoTo ER
  62.     With D
  63.         .SetText S
  64.         .PutInClipboard
  65.         With Sheets(1)
  66.             .Range("a" & .Rows.Count).End(xlUp).Offset(1).Select
  67.             .PasteSpecial Format:="Unicode ¤å¦r"
  68.         End With
  69.     End With
  70.     Exit Sub
  71. ER:
  72.     FormDLL = "FM20.DLL"
  73.     ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\" & FormDLL
  74.     Resume
  75. End Sub
  76. Sub MkDir_Sub(S As String)
  77.     Dim ar, i As Integer, xPath As String
  78.     If Dir(S) = "" Then
  79.         ar = Split(S, "\")
  80.         xPath = ar(0)
  81.         For i = 1 To UBound(ar) - 1
  82.             xPath = xPath & "\" & ar(i)
  83.             If Dir(xPath, vbDirectory) = "" Then MkDir xPath
  84.         Next
  85.     End If
  86. End Sub
  87. Sub Maketxt(xF As String, Q As Range)    '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  88.     Dim fs As Object, E As Range, C As Variant
  89.     Q.Range("C1") = ""
  90.     Q.Range("a4", Q.Range("a4").End(xlDown)).Replace "¦~", ""
  91.     Q.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  92.     Set fs = CreateObject("Scripting.FileSystemObject")
  93.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  94.     For Each E In Q.Rows
  95.         C = Application.Transpose(Application.Transpose(E.Value))
  96.         C = Join(C, vbTab)
  97.         fs.WriteLine C
  98.     Next
  99.     fs.Close
  100. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 49# GBKEE
·PÁÂGBKEEª©¥D¡A49#µ{¦¡½X§Ú¬ã¨s¤F´X¤Ñ¡A¤£¹LÁÙ¬O¤Ó²`¶ø¤F¡A¦³¬Ý¨S¦³«ÜÀ´¡A¦ý¹ê»Ú¤W°õ¦æµ²ªG¬O¦¨¥\ªº¡A¦³¸ÕµÛ¨Ì¼Ëµe¸¬Äª¡A±N¤W¥«ªººô­¶³sµ²¤Î¬ÛÃö¤Þ¼Æ±a¤Jµ{¦¡½X¸ÕµÛÂ^¨ú¸ê®Æ
¦ý¦b¶]¨ì .ParentNode.submit·|¥X²{¨S¦³¨Ï¥ÎÅv­­¡A¦]¬°¤£À´³o¬qµ{¦¡½Xªº·N«ä¡A¯à½Ð±z¦AÀ°¦£¤@¤U¶Ü¡H
¥t¥~¤£ª¾¹D¦b49#ªº°õ¦æµ²ªG¤¤¡A¦³¨S¦³¿ìªk±N¤ë¥÷¶V·sªº©¹¤W±Æ§Ç©O¡H¦A³Â·Ð±z¤@¤UÅo¡I·PÁ¡I
¨Ò¦p¡Gµ{¦¡°õ¦æµ²ªG¬°
103¦~1¤ë
103¦~2¤ë
103¦~3¤ë
103¦~4¤ë

§Æ±æµ²ªG¬°
103¦~4¤ë
103¦~3¤ë
103¦~2¤ë
103¦~1¤ë
  1. Option Explicit
  2. Dim IE As Object
  3. Sub IE_Application()
  4.     Set IE = CreateObject("InternetExplorer.Application")
  5.     With IE
  6.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/FMSRFK/FMSRFKMAIN.php"
  7. '        .Visible = True   '¤£Åã¥Üie
  8.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  9.   End With
  10. End Sub
  11. Sub ¤W¥«¤ë¦¨¥æ¸ê°T()
  12.     Dim Rng As Range, Rng1 As Range, E As Range, X As Range, T As Date, xPath As String, xFile As String
  13.     Dim Ea As Variant, ar(), ii As Integer
  14.     T = Time
  15.     Application.DisplayStatusBar = True
  16.     '½Ð±N¤WÂdªºªÑ²¼¥N¸¹,¦b Sheets(3).Range("A1")©¹¤UKey¤W,°j°é¨Ì³o¸ÌªºªÑ²¼¥N¸¹¶×¤J
  17.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  18.     Set Rng1 = ThisWorkbook.Sheets(3).Range("b:b")
  19.     If Application.Count(Rng) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  20.     If Application.Count(Rng1) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  21.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  22.     Set Rng1 = Rng1.SpecialCells(xlCellTypeConstants)
  23.     xPath = "G:\°]³ø¸ê®Æ"
  24.     IE_Application    '
  25.     Application.StatusBar = " "
  26.     For Each E In Rng
  27.         Sheets(1).UsedRange.Clear  '¤U¸ü¸ê®Æ¸m©ó¦¹¤u§@ªí,ÅÜ´«ªÑ²¼®É:²MªÅ
  28.         For Each X In Rng1
  29.             With IE
  30.                 .Document.getElementsByTagName("select")("myear").Value = X
  31.                  With .Document.getelementbyid("STK_NO")
  32.                     .Value = E
  33.                     .Document.getelementSbyNAME("login_btn")(0).Click  '«ö¤U¬d¸ß
  34.                     .ParentNode.submit
  35.                 End With
  36.                 Do While .Busy Or .readyState <> 4:    Loop
  37.                 If Application.Count(Sheets(1).UsedRange) = 0 Then '¦¹¤u§@ªí²MªÅ®É:¤U¸ü²Ä¤@¦~«×®É
  38.                     ar = Array(0, 2)
  39.                 Else
  40.                     ar = Array(2)
  41.                 End If
  42.                 For Each Ea In ar
  43.                     Ep .Document.getElementsByTagName("TABLE")(Ea).outerHTML
  44.                 Next
  45.             ii = ii + 1
  46.             End With
  47.         Next X
  48.         xFile = xPath & "\" & E & "\HPM.txt"
  49.         MkDir_Sub xFile
  50.         Maketxt xFile, Sheets(1).UsedRange
  51.         Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ"
  52.     Next E
  53.     IE.Quit
  54.     Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ,  Åª¨ú§¹²¦ !! "
  55.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.Text(Time - T, ["MM¤ÀSS¬í"])
  56.     ThisWorkbook.Save
  57. End Sub
  58. Sub Ep(S As String)
  59.     Dim D As New DataObject, E As Shape, FormDLL As String
  60.     'DataObject ª«¥ó ¦b¶i¦æÂà´«°Ê§@®É¡A°µ¬°®æ¦¡¤Æ¤å¦r¸ê®Æªº¼È¦s°Ï°ì¡C¨ä¤]¥i¥H¼È¦s©MÀx¦s¦b DataObject ªº¤å¦r¤ù¬q¬ÛÃöªº®æ¦¡¡C
  61.     '«Å§i Dim D As New DataObject '¶·¦b¤u¨ã-> ³]©w¤Þ¥Î¶µ¥Ø¥[¤J ·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library ,±M®× ¥[¤J¤@ªí³æ§Y¥i
  62.     On Error GoTo ER
  63.     With D
  64.         .SetText S
  65.         .PutInClipboard
  66.         With Sheets(1)
  67.             .Range("a" & .Rows.Count).End(xlUp).Offset(1).Select
  68.             .PasteSpecial Format:="Unicode ¤å¦r"
  69.         End With
  70.     End With
  71.     Exit Sub
  72. ER:
  73.     FormDLL = "FM20.DLL"
  74.     ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\" & FormDLL
  75.     Resume
  76. End Sub
  77. Sub MkDir_Sub(S As String)
  78.     Dim ar, i As Integer, xPath As String
  79.     If Dir(S) = "" Then
  80.         ar = Split(S, "\")
  81.         xPath = ar(0)
  82.         For i = 1 To UBound(ar) - 1
  83.             xPath = xPath & "\" & ar(i)
  84.             If Dir(xPath, vbDirectory) = "" Then MkDir xPath
  85.         Next
  86.     End If
  87. End Sub
  88. Sub Maketxt(xF As String, Q As Range)    '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  89.     Dim fs As Object, E As Range, C As Variant
  90.     Q.Range("C1") = ""
  91.     Q.Range("a4", Q.Range("a4").End(xlDown)).Replace "¦~", ""
  92.     Q.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  93.     Set fs = CreateObject("Scripting.FileSystemObject")
  94.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  95.     For Each E In Q.Rows
  96.         C = Application.Transpose(Application.Transpose(E.Value))
  97.         C = Join(C, vbTab)
  98.         fs.WriteLine C
  99.     Next
  100.     fs.Close
  101. End Sub
½Æ»s¥N½X
¤W¥«.zip (20.75 KB)

TOP

        ÀR«ä¦Û¦b : ¥Ç¿ù¥XÄb®¬¤ß¡A¤~¯à²M²bµL·Ð´o¡C
ªð¦^¦Cªí ¤W¤@¥DÃD