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

¥æ©ö©ú²Ó¤U¸ü

¦^´_ 6# mannyhsu
  1. Option Explicit
  2. Sub ­ÓªÑ¥æ©ö©ú²Ó¤U¸ü()
  3.     Dim ªÑ²¼¥N¸¹ As String, ¤é´Á As Variant, N As Name, i As Integer, T As Date, A
  4.     Do While Not IsDate(¤é´Á)
  5.         ¤é´Á = InputBox("¿é¤J¬d¸ß¤é´Á", "¤é´Á", Date)
  6.         If ¤é´Á = "" Then End
  7.     Loop
  8.     Do While ªÑ²¼¥N¸¹ = ""
  9.         ªÑ²¼¥N¸¹ = InputBox("ªÑ²¼¥N¸¹", "¿é¤J¬d¸ß¤§ªÑ²¼¥N¸¹", "1101")
  10.         If ¤é´Á = "" Then End
  11.     Loop
  12.     ¤é´Á = Format(¤é´Á, "yyyymmdd")
  13.     T = Time
  14.     With ActiveSheet
  15.         .Cells.Clear
  16.         DoEvents
  17.         Application.ScreenUpdating = False
  18.         Application.StatusBar = False
  19.         With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bsContent.aspx?strDate=" & ¤é´Á & "&StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=1", Destination:=Range("A1"))
  20.             .BackgroundQuery = True
  21.              .WebTables = "6,7"
  22.             .Refresh BackgroundQuery:=False
  23.              .ResultRange(1).End(xlDown).Offset(2).CurrentRegion.Cut .ResultRange(1).End(xlToRight).Offset(, 1)
  24.             If Application.CountA(.ResultRange) = 0 Then
  25.                 MsgBox Format(¤é´Á, "0000/00/00") & " ¥ð¥«!!!  ©Î  ªÑ²¼¥N¸¹:" & ªÑ²¼¥N¸¹ & " ¿ù»~ !!!"
  26.                 [A1].Select
  27.                 End
  28.             End If
  29.             ActiveSheet.Names(.Name).Delete
  30.         End With
  31.         i = 2
  32.         Do
  33.             .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Select
  34.             With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bsContent.aspx?strDate=" & ¤é´Á & "&StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=" & i, Destination:=Selection)
  35.                 .BackgroundQuery = True
  36.                 .WebTables = "6,7"
  37.                 On Error Resume Next
  38.                 Do
  39.                      Err.Clear
  40.                 .Refresh BackgroundQuery:=False
  41.                 Loop Until Err.Number = 0
  42.                 On Error GoTo 0
  43.                 If Application.CountA(.ResultRange) = 0 Then GoTo OUT
  44.                 .ResultRange(1).End(xlDown).Offset(2).CurrentRegion.Cut .ResultRange(1).End(xlToRight).Offset(, 1)
  45.                 .ResultRange(1).EntireRow.Delete
  46.                 ActiveSheet.Names(.Name).Delete
  47.                 i = i + 1
  48.             End With
  49.         Loop
  50. OUT:
  51.         .[A1].Select
  52.         Application.ScreenUpdating = True
  53.         With .UsedRange
  54.             .WrapText = False
  55.             .Interior.ColorIndex = xlNone
  56.             .Font.Size = 12
  57.             .Columns.AutoFit
  58.             A = CreateObject("WScript.Shell").popup("¦@¤U¸ü " & i & " ­¶¶O®É  " & Format(Time - T, "hh:mm¤ÀSS¬í"), 5, ¤é´Á & "_" & ªÑ²¼¥N¸¹, 48 + 0)
  59.             Application.StatusBar = ¤é´Á & " _ " & ªÑ²¼¥N¸¹ & " ¦@¤U¸ü " & i & "­¶ ¶O®É " & Format(Time - T, "HH:MM:SS")
  60.         End With
  61.         For Each N In .Names
  62.             N.Delete
  63.         Next
  64.      End With
  65. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2012-8-1 14:46 ½s¿è

¦^´_ 11# lalalada
©Ò¥H¬O¥u¥i¥H¹î¬Ý«e¤@¤é ©Î ·í¤éªº¸ê®Æ
¦^´_ 12# lalalada

.ResultRange-> QueryTablet  ¬d¸ß¶Ç°e¨Óªº¸ê®Æ½d³ò  
.ResultRange(1).->.ResultRange.Cells(1)
vba ªº»¡©ú¤Î½d¨Ò
ResultRange ÄÝ©Ê ½Ð°Ñ¾\®M¥Î¦Ü½d¨Ò¯S©w¶Ç¦^ Range ª«¥ó¡A¸Óª«¥ó¥Nªí«ü©w¬d¸ßªí©ÒÂл\ªº¤u§@ªí°Ï°ì¡C°ßŪ¡C
½d¨Ò
¥»½d¨Ò¹ï²Ä¤@±i¬d¸ßªí¤¤²Ä¤@Ä檺¸ê®Æ¶i¦æ¥[Á`¡A¨Ã¦b¸ê®Æ½d³ò¤U¤èÅã¥Ü²Ä¤@Äæ¸ê®ÆªºÁ`©M¡C
Set c1 = Sheets("sheet1").QueryTables(1).ResultRange.Columns(1)
c1.Name = "Column1"
c1.End(xlDown).Offset(2, 0).Formula = "=sum(Column1)"

TOP

¦^´_ 10# lalalada
   
  .WebTables = "4,""table2"""

­×§ï9#¦p¤U
  1. Option Explicit
  2. Sub ­ÓªÑ¥æ©ö©ú²Ó¤U¸ü()
  3.     Dim ªÑ²¼¥N¸¹ As String, N As Name, i As Integer, T As Date, A
  4.     Do While ªÑ²¼¥N¸¹ = ""
  5.         ªÑ²¼¥N¸¹ = InputBox("ªÑ²¼¥N¸¹", "¿é¤J¬d¸ß¤§ªÑ²¼¥N¸¹", "1101")
  6.         If ªÑ²¼¥N¸¹ = "" Then End
  7.     Loop
  8.     T = Time
  9.     With ActiveSheet
  10.         .Cells.Clear
  11.         DoEvents
  12.         Application.ScreenUpdating = False
  13.         Application.StatusBar = False
  14.         With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=1", Destination:=Range("A1"))
  15.             .WebFormatting = xlWebFormattingNone
  16.             .WebTables = "4,""table2"""
  17.             .Refresh BackgroundQuery:=False
  18.             If Application.CountA(.ResultRange) = 0 Then
  19.                 MsgBox "ªÑ²¼¥N¸¹:" & ªÑ²¼¥N¸¹ & " ¿ù»~ !!!"
  20.                 [a1].Select
  21.                 End
  22.             End If
  23.             ActiveSheet.Names(.Name).Delete
  24.         End With
  25.         i = 2
  26.         Do
  27.             .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Select
  28.              With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=" & i, Destination:=Selection)
  29.                 .WebFormatting = xlWebFormattingNone
  30.                 .WebTables = "table2"
  31.                 On Error Resume Next
  32.                 Do
  33.                      Err.Clear
  34.                     .Refresh BackgroundQuery:=False
  35.                 Loop Until Err.Number = 0
  36.                 On Error GoTo 0
  37.                 If Application.CountA(.ResultRange) = 0 Then GoTo OUT
  38.                 .ResultRange(1).EntireRow.Delete
  39.                 ActiveSheet.Names(.Name).Delete
  40.                 i = i + 1
  41.             End With
  42.         Loop
  43. OUT:
  44.         .[a1].Select
  45.         Application.ScreenUpdating = True
  46.         .Columns.AutoFit
  47.         A = CreateObject("WScript.Shell").popup("¦@¤U¸ü " & i & " ­¶¶O®É  " & Format(Time - T, "hh:mm¤ÀSS¬í"), 5, "_" & ªÑ²¼¥N¸¹, 48 + 0)
  48.         Application.StatusBar = "ªÑ²¼¥N¸¹ [" & ªÑ²¼¥N¸¹ & "] ¦@¤U¸ü " & i & "­¶ ¶O®É " & Format(Time - T, "HH:MM:SS")
  49.         For Each N In .Names
  50.             N.Delete
  51.         Next
  52.      End With
  53. End Sub
½Æ»s¥N½X

TOP

¦^´_ 23# tsuneng
¨Ã«D¤@µ{¦¡¥iµL¼Äªº
½Ð¤W¶Ç: ¤WÂd¦¨¥æ¸ê®Æºô­¶
§Ú¨Ó¸Õ¸Õ¬Ý

TOP

¦^´_ 26# tsuneng
Åý§A¥¢±æ¤F, ¸Õ¤F¤@¤Ñ ¤´¬O¥¢±Ñ ¹ïºô­¶»y¨¥¤£¼ô µLªk¤U¸ü ³oºô§}©Ò¦³ªº¸ê®Æ
http://www.gretai.org.tw/ch/stock/aftertrading/broker_trading/brokerBS.php?  À|¸Õ¥Î IE ¤U¸üTables ªº¤º®e ¦ýÁÙ¬O¥¢±Ñ
¦phttp://forum.twbts.com/viewthread.php?tid=7395&page=1&extra=#pid42189 ªº5# ªþÀÉ
³ohttp://www.gretai.org.tw/ch/stock/aftertrading/broker_trading/download_ALLCSV.php?'¥i¤U¸ü¥þ³¡CSV: ¦ý¹ïºô­¶¬[ºc¤£¼ô,¼g¤£¥X¥¦ªº°Ñ¼Æ
±æª¾±xªÌ¬Û§U
¥Î EXCEL  WEBªº¬d¸ß¤]¦³©Ò­­¨î,¥u¥i¬d¬Ý²Ä¤@­¶ªº¸ê®Æ,
  1. Option Explicit
  2. Sub Ex()
  3.     With ActiveSheet.QueryTables.Add("URL;http://www.gretai.org.tw/ch/stock/aftertrading/broker_trading/brokerBS.php?stk_code=6121", ActiveSheet.[A1])
  4.         .WebSelectionType = xlSpecifiedTables
  5.         .WebFormatting = xlWebFormattingNone
  6.         .WebTables = "11,13,14"
  7.         .Refresh BackgroundQuery:=False
  8.     End With
  9. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2012-8-11 06:54 ½s¿è

¦^´_ 33# diabo
·PÁ¬ۧU ¦¨¥\!
  1. Option Explicit
  2. Private Sub ¤U¸ühtm()
  3.     Dim xml As Object     '¥Î¨Ó¨ú±oºô­¶¸ê®Æ
  4.     Dim stream            'As ADODB.stream   '¥Î¨ÓÀx¦s¤G¶i¦ìÀÉ®×
  5.     Dim URL As String     '¥Øªººô§}
  6.     Dim thePOSTdata       '°Ñ¼Æ
  7.     Set xml = CreateObject("Microsoft.XMLHTTP")
  8.     Set stream = CreateObject("ADODB.stream")
  9.     URL = "http://www.gretai.org.tw/ch/stock/aftertrading/broker_trading/download_ALLCSV.php"
  10.     thePOSTdata = "curstk=3527&stk_date=1010810"
  11.         xml.Open "POST", URL, 0
  12.         xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  13.         xml.send thePOSTdata
  14.     With stream
  15.         .Open
  16.         .Type = 1
  17.         .write xml.ResponseBody
  18.         If Dir("D:\3527.CSV") <> "" Then Kill "D:\3527.CSV"
  19.         .SaveToFile ("D:\3527.CSV")                              
  20.         .Close
  21.     End With
  22. Set xml = Nothing
  23. Set stream = Nothing
  24. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ¥@¤W¦³¨â¥ó¨Æ¤£¯àµ¥¡G¤@¡B§µ¶¶ ¤G¡B¦æµ½¡C
ªð¦^¦Cªí ¤W¤@¥DÃD