Board logo

標題: 如何撈兩筆以上股票資料 [打印本頁]
作者: afu9240    時間: 2017-11-14 22:27     標題: 如何撈兩筆以上股票資料

各位高手好
  小妹 vba小嫩嫩,這段程式有什麻方式可修改 讓他不會卡住,求幫忙!!!感謝
  1. Sub stock()
  2.     Dim oXMLHTTP As Object
  3.     Dim sPageHTML As String
  4.     Dim sURL As String '前面三項變數必key
  5.     a = 0
  6.     Do
  7.         a = a + 1
  8.         Select Case a
  9.             Case 1
  10.                 sURL = "https://tw.stock.yahoo.com/q/q?s=" & Sheets(3).Cells(36, 6) '連結股票代號
  11.             Case 2
  12.                 sURL = "https://tw.stock.yahoo.com/q/q?s=" & Sheets(3).Cells(37, 6)
  13.             
  14.             
  15.             End Select
  16.             Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
  17.             oXMLHTTP.Open "GET", sURL, False
  18.             oXMLHTTP.send
  19.             sPageHTML = oXMLHTTP.responseText
  20.             
  21.             Select Case a
  22.                 Case 1
  23.                     Sheets(5).Cells(1, 1) = sPageHTML '將網頁資訊貼到這個位置
  24.                 Case 2
  25.                     Sheets(5).Cells(1, 2) = sPageHTML
  26.                
  27.                
  28.                     
  29.             End Select
  30.             If a = 2 Then
  31.                  Exit Do
  32.             End If
  33.                
  34.      Loop
  35.    
  36.     aaa = Sheets(5).Cells(1, 1) '網址路徑aaa
  37.    
  38.     aaalen = Len(aaa)  'len取網頁資訊
  39.    
  40.    
  41.     yy = 0
  42.     Y = 1
  43.         For t = 1 To aaalen    '到網頁找特徵資料來擷取我們要的資料
  44.            
  45.         If Mid(aaa, t, Len("nowrap")) = "nowrap" Then '特徵nowrap 要去文字檔搜尋網頁特徵
  46.             
  47.             
  48.         cc = 0
  49.             
  50.         t = t + Len("nowrap")
  51.         q1 = ""
  52.       

  54.         Do
  55.             If Mid(aaa, t, 1) = ">" Then 'aaa網路路徑資料,第t個值取第一筆資料

  57.                 q1 = ""
  58.                 cc = 1
  59.                 yy = yy + 1
  60.                 Y = Y + 1
  61.                 If yy = 2 Then 'yy為第幾筆資料
  62.                     t = t + 4 '從特徵資料到你要擷取的資料要加多少
  63.                 ElseIf yy = 5 Then
  64.                     t = t + 21
  65.                 Else
  66.                     t = t + 1
  67.                 End If


  70.           End If
  71.           If Mid(aaa, t, 1) = "<" Then
  72.             If yy = 5 Then
  73.                 Sheets(4).Cells(2, Y) = Left(RTrim(LTrim(q1)), Len(RTrim(LTrim(q1))) - 1) '將該欄資料置中
  74.                
  75.             Else
  76.                 Sheets(4).Cells(2, Y) = RTrim(LTrim(q1))
  77.          
  78.             End If
  79.             q1 = ""
  80.             cc = 0
  81.             Exit Do
  82.         End If
  83.         If cc = 1 Then
  84.            q1 = q1 & Mid(aaa, t, 1)
  85.         End If

  87.             t = t + 1
  88.         Loop
  89.      
  90.     End If
  91.      
  92.      
  93.      
  94.         bbb = Sheets(5).Cells(1, 2) '網址路徑aaa

  96.         bbblen = Len(bbb) 'len取網頁資訊

  98.         yy = 0
  99.         Y = 1
  100.          For i = 1 To bbblen '到網頁找特徵資料來擷取我們要的資料
  101.         If Mid(bbb, i, Len("nowrap")) = "nowrap" Then '特徵nowrap 要去文字檔搜尋網頁特徵
  102.         cc = 0
  103.         i = i + Len("nowrap")
  104.         q1 = ""

  106.         Do
  107.             If Mid(bbb, i, 1) = ">" Then 'aaa網路路徑資料,第t個值取第一筆資料

  109.                 q1 = ""
  110.                 cc = 1
  111.                 yy = yy + 1
  112.                 Y = Y + 1
  113.                 If yy = 2 Then 'yy為第幾筆資料
  114.                     i = i + 4 '從特徵資料到你要擷取的資料要加多少
  115.                 ElseIf yy = 5 Then
  116.                     i = i + 21
  117.                 Else
  118.                     i = i + 1
  119.                 End If


  122.             End If
  123.             If Mid(bbb, i, 1) = "<" Then
  124.             If yy = 5 Then
  125.                 Sheets(4).Cells(3, Y) = Left(RTrim(LTrim(q1)), Len(RTrim(LTrim(q1))) - 1) '將該欄資料置中

  127.             Else
  128.                 Sheets(4).Cells(3, Y) = RTrim(LTrim(q1))





  134.             End If
  135.             q1 = ""
  136.             cc = 0
  137.             Exit Do
  138.         End If
  139.         If cc = 1 Then
  140.             q1 = q1 & Mid(bbb, i, 1)
  141.         End If

  143.             i = i + 1


  146.         Loop
  147.      End If
  148.     Next i
  149.    Next t
  150.    
  151. End Sub
複製代碼
作者: Scott090    時間: 2017-11-15 09:00

回復 1# afu9240

請問 這個程式碼 是要撈股票的什麼資料?
是這樣嗎?
    股票
    代號        時間        成交        買進        賣出        漲跌        張數        昨收        開盤        最高        最低        個股資料
作者: afu9240    時間: 2017-11-15 12:43

回復 2# Scott090


    我把檔案寄給你 看一下
作者: afu9240    時間: 2017-11-15 12:47

檔案如附件,我要撈的股票在前sheets,您幫我看下,code會卡住,並須要強迫關閉[[attach]27969[/attach][attach]27969[/attach][attach]27969[/attach]
作者: Scott090    時間: 2017-11-15 23:16

回復 4# afu9240

請先參考這個範例
    http://forum.twbts.com/viewthrea ... hlight=%AA%D1%B2%BC
作者: afu9240    時間: 2017-11-16 10:44

感謝s大,真的是高手如雲,想請教要看兩檔以上的股票,裡面的code只要再加上網址就好嗎???
作者: Scott090    時間: 2017-11-16 18:22

回復 6# afu9240


    1. 請貼出程式碼作品會比較容易瞭解問題
    2. 不要忘了 在 "回復" 的地方按一下
作者: afu9240    時間: 2017-11-17 16:24

我前面有附上檔案過給您看,一次只能看一檔個股
作者: Scott090    時間: 2017-11-18 10:32

回復 8# afu9240

這是妳要的嗎?
    [attach]27986[/attach]
[attach]27987[/attach]

[attach]27988[/attach]



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)