Excel VBA能抓取某个网站公布的历史数据吗
1、这个问题相对比较专业。
建议再去知乎看看2、另外咨询下淘宝看看卖VBA程序的人都给出什么方案3、以下代码转载自网络:Dim httpSet http = CreateObject("Microsoft.XMLHTTP")http.Open "POST", "连接地址", Falsehttp.send ""If http.Status = 200 Thenselection.text=http.responseTextEnd If二是开启IE进程Sub test()Set ie = CreateObject("InternetExplorer.Application") '设置变量With ie '设置块.Navigate ("需要打开的网页的网址") '打开网页.Visible = True '是否显示ie窗口While .readystate <> 4 '延迟等待页面加载完毕DoEventsWendFor i = 22 To 49 Step 3 '取数循环S = S & " " & .Document.all.tags("td")(i).innerTEXT '取数据到变量,熟悉HTML的DOM可以修改这个实现各种内容Next iEnd With '块结束S = LTrim(S) '删除左边空格Application.SendKeys "^{F4}" '发送按键关闭当前浏览器标签MsgBox S '显示结果Set ie = Nothing '释放内存End Sub
谢谢你的回答。
请问VBA抓取网页数据,能不能做到?
可以,通过Excel——数据——自网站,录取一份代码,根据代码进行适当修改,提取所需数据。
举例:Sub 读取网页数据()Dim sAddress As StringFor i = 1 To 90sAddress = Range("A" & Range("A:A").Rows.Count).End(xlUp).Offset(1, 0).AddressWith ActiveSheet.QueryTables.Add(Connection:= _"URL;" & i, Destination:=Range(sAddress)).Name = "page=" & i.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 = """listTable""".WebPreFormattedTextToColumns = True.WebConsecutiveDelimitersAsOne = True.WebSingleBlockTextImport = False.WebDisableDateRecognition = False.WebDisableRedirections = False.Refresh BackgroundQuery:=FalseEnd WithNext iEnd Sub 上面代码不全,网址部分被屏蔽了,参考:http://zhidao.baidu.com/question/1990077664368754987
Excel 如何用VBA实现自动抓取分页的数据
1,先表明一下你的说法,“从浏览器中复制表格到一个文本文档或剪贴板” 表格复制后放入文体文档是只能保留文字和数据,这种格式为TXT文档,站点有提供下载功能,另站点还提供XLS格式的EXCEL表格下载。
如果你只需要开奖数据,以上已经足够。
2,做VBA动态更新分析表所用到的。
经过查看你提供的网页源代码,复制了关于数据这一段:期数开奖号码开奖时间中奖组合 并查了class和ID属性值,所引用的是经过JavaScript处理调用数据库的值,不是一个文本文件的集合,如:双色球的文体文件如下:http://www.17500.cn/getData/ssq.TXT 这种才可好处理,示列如下:Private Sub CommandButton1_Click() Range("A3:AC3500").Clear k3dshijihao = "http://www.17500.cn/getData/ssq.TXT" d3s = "WData3D_All" Cells(2, 1) = "开奖期号" Cells(2, 2) = "开奖日期" Cells(2, 3) = "红" Cells(2, 4) = "球" Cells(2, 5) = "大 " Cells(2, 6) = "小" Cells(2, 7) = "顺" Cells(2, 8) = "序" Cells(2, 9) = "蓝" Cells(2, 10) = "红" Cells(2, 11) = "球" Cells(2, 12) = "出" Cells(2, 13) = "球" Cells(2, 14) = "顺" Cells(2, 15) = "序" Cells(2, 16) = "投注总额" Cells(2, 17) = "奖池金额" Cells(2, 18) = "一等注数" Cells(2, 19) = "一等金额" Cells(2, 20) = "二等注数" Cells(2, 21) = "二等金额" Cells(2, 22) = "三等注数" Cells(2, 23) = "金额" Cells(2, 24) = "四等注数" Cells(2, 25) = "金额" Cells(2, 26) = "五等注数" Cells(2, 27) = "金额" Cells(2, 28) = "六等注数" Cells(2, 29) = "金额" cz = k3dshijihao: czmc = d3s With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & cz, Destination:=Range("A3")) .Name = czmc .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = xlWindows .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = True .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = True .TextFileColumnDataTypes = Array(1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Range("A" & (Application.Count(Range("a1:a3000")))).Select End End Sub 将以上代码贴到VBA中,再加个按钮指定它,试试结果,如果是你想要的这种结果 可以将引用的http://www.17500.cn/getData/ssq.TXT。
改为你网站下载来的TXT文件路径,再做相关VBA代修改就可以完成!
Excel vba如何抓取指定的网页数据到单元格
展开全部 参考:Sub A1下载数据()ReDim A2(1 To 200000, 1 To 15): A = 0For i = 1 To 5Sleep 2000 + 1000 * RndWith CreateObject("WinHttp.WinHttpRequest.5.1")URL = "目标网页" .Open "get", URL, False.setRequestHeader "Host", "xxxxx".SendQ1 = .responseTextQ1 = Replace(Q1, """", "")Q1 = Replace(Q1, Chr(9), "")Q1 = Replace(Q1, Chr(10), "")Q1 = Replace(Q1, Chr(13), "")Q1 = Replace(Q1, "=odd>", "=>")End With'Sheet1.[A2] = Q1B1 = Split(Q1, "")For j = 1 To UBound(B1)B2 = Split(B1(j), "")B3 = Split(Replace(B2(1), "", ""), ",")A2(A + 1, 1) = Replace(B2(2), "", "")A2(A + 1, 2) = Replace(B2(0), "", "")For K = 0 To 9A2(A + 1, 3 + K) = B3(K)NextA = A + 1NextApplication.StatusBar = iNextMsgBox AWith Sheet1If .AutoFilterMode = True Then .AutoFilterMode = False.Rows("2:600000").ClearContentsIf A > 0 Then .[A2].Resize(A, 15) = A2.Rows(1).AutoFilter '数据筛选ActiveWindow.ScrollRow = 1ActiveWindow.ScrollColumn = 1End WithEnd Sub...
Excel 求助各位大侠VBA代码如何抓取网页JSON数据
基本上和JS的代码差不多哦,使用XMLHTTP对象,下面是例子代码:Option ExplicitSub xxx()Dim httpSet http = CreateObject("Microsoft.XMLHTTP")http.Open "POST", "http://网址/PHP文件名.PHP", Falsehttp.send ""If http.Status = 200 Then[a1] = http.responseTextMsgBox "成功。
"ElseMsgBox "调用失败,错误代码:" & http.StatusEnd IfEnd Sub
Excel 如何用vba不断的抓取网页响应信息
代码复制到 报表 代码窗口,不要弄反了哦Sub 获取数据()x = WorksheetFunction.Match([A1], Sheets("数据").Range("B:B"), 0)arr = Sheets("数据").Range("d" & x & ":" & "h" & x)[b4].Resize(1, 5) = arr[b5] = Sheets("数据").Cells(x, "i")End Sub或Sub 获取数据()y = WorksheetFunction.CountIf(Sheets("数据").Range("B:B"), [a1])If y = 0 ThenMsgBox "日期输入错误"Exit SubEnd Ifx = WorksheetFunction.Match([a1], Sheets("数据").Range("B:B"), 0)arr = Sheets("数据").Range("d" & x & ":" & "h" & x)[b4].Resize(1, 5) = arr[b5] = Sheets("数据").Cells(x, "i")End Sub...
转载请注明出处51数据库 » 数据抓取软件 vba