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.       

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

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


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

  82.             t = t + 1
  83.         Loop
  84.      
  85.     End If
  86.      
  87.      
  88.      
  89.         bbb = Sheets(5).Cells(1, 2) '網址路徑aaa

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

  91.         yy = 0
  92.         Y = 1
  93.          For i = 1 To bbblen '到網頁找特徵資料來擷取我們要的資料
  94.         If Mid(bbb, i, Len("nowrap")) = "nowrap" Then '特徵nowrap 要去文字檔搜尋網頁特徵
  95.         cc = 0
  96.         i = i + Len("nowrap")
  97.         q1 = ""

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

  100.                 q1 = ""
  101.                 cc = 1
  102.                 yy = yy + 1
  103.                 Y = Y + 1
  104.                 If yy = 2 Then 'yy為第幾筆資料
  105.                     i = i + 4 '從特徵資料到你要擷取的資料要加多少
  106.                 ElseIf yy = 5 Then
  107.                     i = i + 21
  108.                 Else
  109.                     i = i + 1
  110.                 End If


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

  115.             Else
  116.                 Sheets(4).Cells(3, Y) = RTrim(LTrim(q1))





  117.             End If
  118.             q1 = ""
  119.             cc = 0
  120.             Exit Do
  121.         End If
  122.         If cc = 1 Then
  123.             q1 = q1 & Mid(bbb, i, 1)
  124.         End If

  125.             i = i + 1


  126.         Loop
  127.      End If
  128.     Next i
  129.    Next t
  130.    
  131. 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/)