Excel VBA爬取雅虎财经股价 将弹窗输出改为直接粘贴数据求助

只需要将原代码中输出MsgBox的逻辑替换为工作表单元格赋值即可，以下是两个可选版本的修改后代码：

基础版：写入固定单元格 #

直接将最新爬取的股价写入指定固定位置，会覆盖上一次的爬取结果：

Sub SharePrice()
    Dim request As Object
    Dim response As String
    Dim html As New HTMLDocument
    Dim website As String
    Dim price As Variant
    ' 定义要写入的工作表，可将Sheet1替换为你自己的表格名称
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Worksheets("Sheet1")
    
    website = "https://uk.finance.yahoo.com/quote/RTN.L/history?p=RTN.L"
    
    Set request = CreateObject("MSXML2.XMLHTTP")
    request.Open "GET", website, False
    request.setRequestHeader "If-Modified-Since", "Sat,1 Jan 2000 00:00:00 GMT"
    request.send
    
    response = StrConv(request.responseBody, vbUnicode)
    html.body.innerHTML = response
    price = html.getElementsByClassName("Py(10px) Pstart(10px)")(4).innerText
    
    ' 替换原MsgBox逻辑，写入指定单元格，可自行调整单元格位置
    targetSheet.Range("A1").Value = "RTN.L"
    targetSheet.Range("B1").Value = price
    targetSheet.Range("C1").Value = Now()
    ' 可选设置时间格式
    targetSheet.Range("C1").NumberFormat = "yyyy-mm-dd hh:mm:ss"
End Sub

追加版：保留历史爬取记录 #

每次运行自动将新数据追加到表格最后一行，不会覆盖历史爬取记录：

Sub SharePrice()
    Dim request As Object
    Dim response As String
    Dim html As New HTMLDocument
    Dim website As String
    Dim price As Variant
    Dim targetSheet As Worksheet
    Dim nextRow As Long
    Set targetSheet = ThisWorkbook.Worksheets("Sheet1")
    
    ' 定位第一列最后一个非空行的下一行，作为新数据的写入位置
    nextRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 首次运行自动生成表头
    If nextRow = 2 And targetSheet.Range("A1").Value = "" Then
        targetSheet.Range("A1") = "股票代码"
        targetSheet.Range("B1") = "股价"
        targetSheet.Range("C1") = "爬取时间"
        targetSheet.Range("A1:C1").Font.Bold = True
        nextRow = 2
    End If
    
    website = "https://uk.finance.yahoo.com/quote/RTN.L/history?p=RTN.L"
    
    Set request = CreateObject("MSXML2.XMLHTTP")
    request.Open "GET", website, False
    request.setRequestHeader "If-Modified-Since", "Sat,1 Jan 2000 00:00:00 GMT"
    request.send
    
    response = StrConv(request.responseBody, vbUnicode)
    html.body.innerHTML = response
    price = html.getElementsByClassName("Py(10px) Pstart(10px)")(4).innerText
    
    ' 写入新行数据
    targetSheet.Cells(nextRow, "A").Value = "RTN.L"
    targetSheet.Cells(nextRow, "B").Value = price
    targetSheet.Cells(nextRow, "C").Value = Now()
    targetSheet.Cells(nextRow, "C").NumberFormat = "yyyy-mm-dd hh:mm:ss"
End Sub

注意事项 #

• 运行前请在VBA编辑器的「工具」-「引用」中勾选Microsoft HTML Object Library，否则代码会报错
• 如果需要爬取其他股票，只需修改website变量中的股票代码、以及对应写入A列的股票标识即可

内容的提问来源于stack exchange，提问作者StephNeuhX