§ì¨úºô­¶¸ê®Æ

zheng211016

https://histock.tw/stock/financial.aspx?no=3032&t=2
¦U¦ì¤j¯« ¦p¦ó§ì¨ú±q¤W­±ºô§}¤ºªºªí®æ¸ê®Æ ¤p§Ì·Q¾Çvba XMLHTTP ³Ò·Ð¦U¦ì¤j¤j¤F

¤U¸ü (103.88 KB)

2019-4-28 20:58

Scott090

¦^´_ 1# zheng211016

   ½Ð°Ñ¦Ò¡G
    Sub byXMLhttp_Test()
      
      Dim sh As Worksheet
      Dim t!, i%, j%, k%
      Dim myXML As Object, myHTML As Object, myTable, arDATA, URL$

      URL = "https://histock.tw/stock/financial.aspx?no=3032&t=2"
      
       Set sh = Worksheets("¸ÕÅç­¶")
      Set myXML = CreateObject("Microsoft.XMLHTTP")
      Set myHTML = CreateObject("HTMLFile")
      
      With myXML
          .Open "GET", URL, False
          .send
          If .Status <> 200 Then MsgBox "No successful web connection", vbOKOnly: Exit Sub
           myHTML.body.innerhtml = .responsetext
      End With
      Set myTable = myHTML.getelementsbytagname("TABLE")(0)
      
      With myTable
            i = .Rows.Length: j = .Rows(3).Cells.Length
            ReDim arDATA(i, j)
            k = 0
            For i = 1 To .Rows.Length
                  If .Rows(i - 1).innertext <> "" Then
                        k = k + 1
                        For j = 1 To .Rows(0).Cells.Length
                              arDATA(k, j) = .Rows(i - 1).Cells(j - 1).innertext
                        Next
                  End If
            Next

      End With

      sh.Cells.Clear
      sh.[A1].Resize(UBound(arDATA), UBound(arDATA, 2)) = arDATA
      
      Set myXML = Nothing
      Set myHTML = Nothing
      Set myTable = Nothing
End Sub

zheng211016

¦^´_ 2# Scott090


    ·PÁ¤j¤j«ü±Ð  ´ú¸Õ§¹¦³ÂI¤p°ÝÃD ´N¬O·|¦U¤Ö¤@¦æ¤@¦C , ¥t¥~ ¸ê®Æ¦³¿ìªk±qa1¶}©l©ñ¸m¶Ü?

zheng211016

¦^´_ 2# Scott090

Scott090 ¤j¤j §Úªá¶O¤F¤@¬q®É¶¡»{ÃѤFµ{¦¡½X«á ¦Û¦æ¸Ñ¨M¤F°ÝÃD ÁٽФj¤j¹L¥Ø

¥t¥~·Q½Ð±Ð °}¦C ¸ò ³æ¤@ ­þ­Óªá¶O°_¨Óªº®É¶¡¸òªÅ¶¡·|¤ñ¸û¦h?

1. Sub byXMLhttp_Test2()
   
2.       
   
3.       Dim sh As Worksheet
   
4.       Dim t!, i%, j%, k%
   
5.       Dim myXML As Object, myHTML As Object, myTable, arDATA, URL$
   
6.    
   
7.       URL = "https://histock.tw/stock/financial.aspx?no=3032&t=2"
   
8.       Set sh = Worksheets("¸ÕÅç­¶")
   
9.       Set myXML = CreateObject("Microsoft.XMLHTTP")
   
10.       Set myHTML = CreateObject("HTMLFile")
    
11.       sh.Cells.Clear
    
12.       With myXML
    
13.           .Open "GET", URL, False
    
14.           .send
    
15.           If .Status <> 200 Then MsgBox "No successful web connection", vbOKOnly: Exit Sub
    
16.            myHTML.body.innerhtml = .responsetext
    
17.       End With
    
18.       Set myTable = myHTML.getelementsbytagname("TABLE")(0)
    
19.       
    
20.       With myTable
    
21.             i = .Rows.Length: j = .Rows(0).Cells.Length
    
22.             ReDim arDATA(i, j)
    
23.             
    
24.             k = 0 '
    
25.             For i = 1 To .Rows.Length
    
26.                   If .Rows(i - 1).innertext <> "" Then
    
27.                         k = k + 1
    
28.                         For j = 1 To .Rows(0).Cells.Length
    
29.                                 Cells(k, j) = .Rows(i - 1).Cells(j - 1).innertext
    
30.                         Next
    
31.                   End If
    
32.             Next
    
33. 
    
34.       End With
    
35. 
    
36.       Set myXML = Nothing
    
37.       Set myHTML = Nothing
    
38.       Set myTable = Nothing
    
39.       
    
40. End Sub

½Æ»s¥N½X

Scott090

¦^´_ 4# zheng211016

  ¬Ý¸ê®Æªº¦h¹è¡A ¸ê®Æ¦hªº¸Ü¬O¥Î°}¦C·|¸û§Ö¡C   

¤£¤F¸Ñª©¥Dªº·N«ä¡A
    1. "¦U¤Ö¤@¦æ¤@¦C"  ¬O¬Æ»ò¸ê®Æº|±¼¤F? ½ÐÁ|¨Ò¥H«K©ú¥Õ¡C
     2. ¨Ì·Ó³o­Óª©¥»¡A ¥¦¤w¸g¬O ±q [A1] ¶}©l¤F¡C
            k=0
            For i = 1 To .Rows.Length
                  If .Rows(i - 1).innertext <> "" Then
                        k = k + 1
                        For j = 1 To .Rows(0).Cells.Length
                               sh.Cells(k, j) = .Rows(i - 1).Cells(j - 1).innertext
                        Next
                  End If
            Next

zheng211016

¦^´_ 5# Scott090

¤U¸ü (406.11 KB)

2019-5-11 00:14

§Ú´ú¸Õªºµ²ªG¦p¤W ¥L±qB2¶}©l©ñ¸m°}¦C¸ê®Æ
§Ú»¡¿ù ¬O¤Ö¤F¼W¸ê»{ÁÊ»ù ³oÄæ¦Ó¤w
¥t¥~ ½Ð°ÝS¤j §A¦p¦ó§ä¥X¥L¬O²Ä´Xtable , ÁÙ¦³­Y¤µ¤Ñ¸ê®Æ¬O·|Åܰʪº¨º­n«ç§ì
¨Ò¦p³o­Óºô¯¸ : http://mis.twse.com.tw/stock/fibest.jsp?stock=3231
¥H¤U¹Ï¤º¨â­Ó¤jªí®æ¸ê®Æ(¾îªº¨º­Ó ÁÙ¦³ ¶R½æ5ÀÉ)

¤U¸ü (33.72 KB)

2019-5-11 00:18

Scott090

¦^´_ 6# zheng211016
   
   ½Ðª`·N°Ñ¦Ò¬õ¦rªº³¡¤À¡A°}¦C±q 1 ¶}©l¡G
Option Base 1
Sub byXMLhttp_Test2()
      
      Dim sh As Worksheet
      Dim t!, i%, j%, k%
      Dim myXML As Object, myHTML As Object, myTable, arDATA, URL$
   
      URL = "https://histock.tw/stock/financial.aspx?no=3032&t=2"
      Set sh = Worksheets("¸ÕÅç­¶")
      Set myXML = CreateObject("Microsoft.XMLHTTP")
      Set myHTML = CreateObject("HTMLFile")
      sh.Cells.Clear
      With myXML
          .Open "GET", URL, False
          .send
          If .Status <> 200 Then MsgBox "No successful web connection", vbOKOnly: Exit Sub
           myHTML.body.innerhtml = .responsetext
      End With
      Set myTable = myHTML.getelementsbytagname("TABLE")(0)
      
      With myTable
            i = .Rows.Length: j = .Rows(0).Cells.Length
            ReDim arDATA(i, j)
            
            k = 0 '
            For i = 1 To .Rows.Length
                  If .Rows(i - 1).innertext <> "" Then
                        k = k + 1
                        For j = 1 To .Rows(0).Cells.Length
                                Cells(k, j) = .Rows(i - 1).Cells(j - 1).innertext
                                arDATA(k, j) = .Rows(i - 1).Cells(j - 1).innertext
                        Next
                  End If
            Next

      End With
      sh.[A15].Resize(UBound(arDATA), UBound(arDATA, 2)) = arDATA
      Set myXML = Nothing
      Set myHTML = Nothing
      Set myTable = Nothing
      
End Sub

Scott090

¦^´_ 6# zheng211016

     "¨Ò¦p³o­Óºô¯¸ : http://mis.twse.com.tw/stock/fibest.jsp?stock=3231"
     ³q±` "TWSE" ³o­Óºô¯¸ ¥Îµ{¦¡¹ï§Ö³t´£¨ú¸ê®Æ ¦n¹³·| ªý¾× IP ³s½u¡A
      §Ú¤£·|¥Î¡A±`±`¥¢±Ñ¡F ©êºp

Scott090

¦^´_ 6# zheng211016

    °²¦pª©¤jÄ@·N±q Excel ¤ºªº¸ê®Æ¨Ó·½"³sµ²web" ¿ý»s VBA ªº¸Ü¡G
    Sub ¥¨¶°1()
'
' ¥¨¶°1 ¥¨¶°
'    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://histock.tw/stock/financial.aspx?no=3032&t=2", Destination:=Range _
        ("$A$1"))
        .Name = "financial.aspx?no=3032&t=2"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
  '.WebTables = "1"¡A ¦ýµ{¦¡¸Ì¬O±q "0" °_ºâªº©Ò¥H "1" ´N¬O Table 0¡C
       .WebTables = "1"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Application.Left = 155.8
    Application.Top = 76
End Sub
       ¥H¤W¶È¨Ñ°Ñ¦Ò

zheng211016

¦^´_ 9# Scott090


    ¹ê´ú¨S°ÝÃD ÁÂÁ±z  Scott090 ¤j¤j §AÁ¾µê¤F ·PÁ¤j¤j Åý§Ú¨ü¯q¨}¦h !!!!!