Function FillOneRow(url As String, r As Integer) As IntegerWith CreateObject("msxml2.xmlhttp").Open "GET", url, False.sendsp = Split(.responsetext, "~")If UBound(sp) > 3 ThenFillOneRow = 1Cells(r, 2).Value = sp(1) '名称Cells(r, 3).Value = sp(3) '当前价格Cells(r, 4).Value = sp(4) '昨日收盘价Dim zhangDie As DoublezhangDie = sp(32)Cells(r, 5).Value = zhangDieIf zhangDie > 0 Then'上涨使用红色Cells(r, 5).Font.Color = vbRedCells(r, 3).Font.Color = vbRedElse'下跌使用绿色Cells(r, 5).Font.Color = &H228B22Cells(r, 3).Font.Color = &H228B22End IfElseFillOneRow = 0End IfEnd WithEnd FunctionSub GetData()Dim succeeded As IntegerDim url As StringDim row As IntegerDim code As StringFor row = 2 To Range("A1").CurrentRegion.Rows.Count '从第二行开始code = Cells(row, 1).ValueIf code <> "" Thenurl = "http://qt.gtimg.cn/q=sh" & code '沪市succeeded = FillOneRow(url, row)If succeeded = 0 Thenurl = "http://qt.gtimg.cn/q=sz" & code '深市succeeded = FillOneRow(url, row)End IfIf succeeded = 0 ThenMsgBox ("获取失败")End IfEnd IfNextEnd Sub'点开ThisWorkbook，输入下列代码Private Sub Workbook_Open()Call Sheet1.GetDataEnd Sub
