用excel盯盘

Function GetSinaHttpGBK(url As String) As String    Dim http As Object    ' 改用 WinHttpRequest，TLS 和 Header 控制更稳    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")    ' 强制 TLS1.2（Win7/Win10 兼容）    http.Option(9) = 2048    http.Open "GET", url, False    ' 新浪必须带以下头，否则直接 403 或 Kinsoku 报错    http.SetRequestHeader "Referer", "https://finance.sina.com.cn/"    http.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36"    On Error Resume Next    http.Send    If http.Status <> 200 Then        GetSinaHttpGBK = ""        Set http = Nothing        Exit Function    End If    ' GBK 转码    Dim stream As Object    Set stream = CreateObject("ADODB.Stream")    stream.Type = 1    stream.Open    stream.Write http.ResponseBody    stream.Position = 0    stream.Type = 2    stream.Charset = "GBK"    GetSinaHttpGBK = stream.ReadText    stream.Close    Set stream = Nothing    Set http = NothingEnd FunctionSub GetPrice_Sina()    Dim ws As Worksheet    Set ws = ThisWorkbook.Sheets(1)    Dim lastCol As Long    lastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column    Dim i As Long    For i = 2 To lastCol        Dim stockCode As String        stockCode = Trim(ws.Cells(2, i).Value)        If stockCode = "" Then GoTo NextCol        ' 必须用 HTTPS        Dim url As String        url = "https://hq.sinajs.cn/list=" & stockCode        Dim resp As String        resp = GetSinaHttpGBK(url)        If resp = "" Then            ws.Cells(3, i).Value = "ERR"            GoTo NextCol        End If        On Error Resume Next        Dim parts() As String        parts = Split(resp, """")        Dim dataFields() As String        dataFields = Split(parts(1), ",")        Dim price As String        price = Trim(dataFields(3))        If IsNumeric(price) Then            ws.Cells(3, i).Value = CDbl(price)        Else            ws.Cells(3, i).Value = "N/A"        End If        On Error GoTo 0NextCol:    Next i    MsgBox "新浪财经：获取完成！", vbInformationEnd Sub'==========================================' 腾讯按钮 → 获取现价到第三行'==========================================Sub GetPrice_Tencent()    Dim ws As Worksheet    Set ws = ThisWorkbook.Sheets(1)    Dim lastCol As Long    lastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column    ' 从 B 列开始（跳过 A 列）    Dim i As Long    For i = 2 To lastCol        Dim stockCode As String        stockCode = Trim(ws.Cells(2, i).Value)        If stockCode = "" Then GoTo NextCol        Dim url As String        url = "http://qt.gtimg.cn/q=" & stockCode        Dim resp As String        resp = GetSinaHttpGBK(url)        If resp = "" Then            ws.Cells(3, i).Value = "ERR"            GoTo NextCol        End If        ' 解析现价：按双引号分割，再按 ~ 分割        ' 腾讯格式：v_xxx="类型~名称~代码~现价~昨收~今开~..."        ' 现价在 ~ 分割后的 index 3        On Error Resume Next        Dim parts() As String        parts = Split(resp, """")        Dim dataFields() As String        dataFields = Split(parts(1), "~")        Dim price As String        price = Trim(dataFields(3))        If IsNumeric(price) Then            ws.Cells(3, i).Value = CDbl(price)        Else            ws.Cells(3, i).Value = "N/A"        End If        On Error GoTo 0NextCol:    Next i    MsgBox "腾讯财经：获取完成！", vbInformationEnd Sub

Sub RecordDataSnapshot()    Dim wsSource As Worksheet    Dim wsTarget As Worksheet    Dim nextRow As Long    ' 定义工作表    Set wsSource = ThisWorkbook.Sheets("Sheet1")    Set wsTarget = ThisWorkbook.Sheets("Sheet2")    ' 在Sheet2中找到第一列最后一个非空单元格的下一行    nextRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1    ' 关键：使用 .Value2 仅复制数值（忽略公式），速度更快更干净    wsTarget.Range("A" & nextRow).Value2 = wsSource.Range("A3").Value2 ' 日期    wsTarget.Range("B" & nextRow & ":J" & nextRow).Value2 = wsSource.Range("B3:J3").Value2 ' 数据区域    ' 提示完成（可选，不想弹窗可以把下面这行删掉）    MsgBox "数据已固化至 Sheet2 第 " & nextRow & " 行！", vbInformationEnd Sub