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

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

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¶È¨Ñ°Ñ¦Ò