Anywhere you go, let me go too

關於部落格
對人海闊天空,做事仔細周密
  • 31752

    累積人氣

  • 2

    今日人氣

    0

    訂閱人氣

同步股票價格資料~

 在我的理財excel有個sheet 專門存放我買的股票,這幾天看了一下前幾天買的一本書,覺得把這個功能補上去,坦白說還是要懂的寫程式比較可能辦到,我看有些網站教人....只教如何錄製巨集. 說什麼不會寫程式也沒有關係..........:|本人非常不認同....只會錄不會寫程式.....有不滿意的地方,不改嗎?????

我有怪廦........我會受不了~:-(

直接提供我的作法,下面是我股票投資的UI


首先我先在增加一個sheet用以存放單一股票價格的暫存資料,接著增加一個button,如上圖所示,
為了快速開發(重點是坊間沒有多少vbs的書,而且這個開發工具又不像VS這麼人性化) , 所以我先用錄製巨集 ,進行連線至Yahoo網站, 查詢單一股票的價格資訊, 這時就會自動產生一斷程式碼.....

之後就是調整程式, 把它改成我預期的(就是要像前一篇, 可以依股票代碼,逐一去將所有價格都填入右方欄位中)

程式如下:

Step1 : 抓取單一股票價格
 
'自Yahoo抓取特定股票價格資料
Function catchStockValue(sStockId As String)
 
     On Error Resume Next
   
      Sheet9.Select '選擇你要暫存股價的Sheet
      'Sheet9.Activate 'focus Sheet9 '為了減少UI切換..
      Sheet9.Range("A1").Select
 
      
    ' 自組URL
    Dim myStockURL As String
    myStockURL = "https://tw.stock.yahoo.com/q/q?s=" + sStockId
    
    With Sheet9.QueryTables.Add(Connection:= _
        "URL;" + myStockURL, Destination:=Range("$A$1"))  'URL改用自組的
        .CommandType = 0
        .Name = "q?s=" + sStockId + "_1"  '股票代號變成動態代入的
        .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 = "7"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Cells.Select
    Selection.NumberFormatLocal = "G/通用格式"
    Cells.Select.Range("B3").Select
    Cells.Select.NumberFormatLocal = "[$-x-systime]h:mm:ss AM/PM"
End Function
Step2 : 清空sheet 內容
'清空所有股價資料
Function clearStockValue()
 
   On Error Resume Next
 
    Sheet9.Select '選擇你要暫存股價的Sheet
    Sheet9.Cells.Select
    Selection.QueryTable.Delete
    Selection.ClearContents
End Function

Step3: 撰寫更新單一股票價格程式(這個不是用錄製巨集出來的.....所以我說...應該要懂的寫程式才有可能.....)
 
'抓取單一股票最新收盤價資訊,放入相對欄位中
'sRealStockNo 本次欲抓之股票代號
'
Function CatchSingleStockData(sRealStockNo As String, iNowRow As Integer)
 
    On Error Resume Next
   
   
   clearStockValue '清空暫存淨值資料
   catchStockValue (sRealStockNo) '抓取本次想抓取得股票代號
   
      Sheet9.Select '選擇你要暫存股價的Sheet
      'Sheet9.Activate
      Sheet9.Range("A3").Select '因為第三列才開始放入股價
     
   Dim MyArray(0, 6)
   '股票名稱(0) 時間(1) 成交價(2) 買進(3) 賣出(4) 漲跌(5) 張數(6) 昨收(7) 開盤(8) 最高(9) 最低(10)
     
    MyArray(0, 0) = ActiveCell.Offset(0, 2).Value  '第一欄 成交價(股價)
    MyArray(0, 1) = ActiveCell.Offset(0, 5).Value '第二欄  漲跌
    MyArray(0, 2) = ActiveCell.Offset(0, 7).Value  '第三欄  昨收
    MyArray(0, 3) = ActiveCell.Offset(0, 8).Value  '第三欄  開盤
    MyArray(0, 4) = ActiveCell.Offset(0, 9).Value  '第三欄  最高
    MyArray(0, 5) = ActiveCell.Offset(0, 10).Value  '第三欄  最低
    MyArray(0, 6) = ActiveCell.Offset(0, 1).Value  '第三欄  時間
    
   
   '更新股價資料
   Sheet2.Select '選擇股票投資sheet
   Sheet2.Activate 'focus Sheet2
   
   'My Stock Field
   '股票代號(B) 證券名稱(C)  集保股數(D)   最高價(E)  最低價(F)  T日成交價(G)  漲/跌(H)   集保庫(I)  理財資訊(J,K)  時間(L) T-1收盤價(M)
    
   '最高價(E)
   sField_org = "E" & iNowRow
   ActiveSheet.Range(sField_org).Select
   ActiveCell.Formula = MyArray(0, 4)
   '最低價(F)
   sField_org = "F" & iNowRow
   ActiveSheet.Range(sField_org).Select
   ActiveCell.Formula = MyArray(0, 5)
   'T日成交價 (G)
   sField_org = "G" & iNowRow
   ActiveSheet.Range(sField_org).Select
   ActiveCell.Formula = MyArray(0, 0)
   '漲/跌(H)
   sField_org = "H" & iNowRow
   ActiveSheet.Range(sField_org).Select
   ActiveCell.Formula = MyArray(0, 1)
   '時間(L)
   sField_org = "L" & iNowRow
   ActiveSheet.Range(sField_org).Select
   ActiveCell.Formula = MyArray(0, 6)
   'T-1收盤價(M)
   sField_org = "M" & iNowRow
   ActiveSheet.Range(sField_org).Select
   ActiveCell.Formula = MyArray(0, 2)
End Function

Step4: 逐一讀取你有投資料股票,依序進行同步更新 (同理...要自己寫程式)
'抓取股票最新收盤價
Sub CatchStockData()
   
   On Error Resume Next
   
    Dim sRealStockNo As String '股票代號  
    Dim iRowCount As Integer
    
    
    Dim RangeStockData As Range
    Dim RangeNowStockData As Range
    Dim ResultRange As Range
    
    
    Set RangeStockData = Sheet2.Range("B6:B9") '存放股票代號欄位
    
    
        For Each RangeNowStockData In RangeStockData
        
          iRowCount = iRowCount + 1
        
                sRealStockNo = RangeNowStockData.Value
                ResultRange = CatchSingleStockData(sRealStockNo, iRowCount + 5)
        Next
   
End Sub


以後如果想更新.....按一下就行了......愈來愈懶了~(頂尖工程師都是愛好偷懶的:D, 向他們看齊8-))
 


相簿設定
標籤設定
相簿狀態