查看: 421|回复: 10
已解决：VBA将东方财富网龙虎榜个股明细放入excel表格中
阅读权限20
在线时间 小时
本帖最后由 俊锋伍贰零 于
10:12 编辑
求教：：：如何用VBA将这个页面（东方财富网龙虎榜个股明细）放入excel表格中……因为这个网页不够精简……O(∩_∩)O谢谢
阅读权限50
在线时间 小时
Sub test()
& & Dim QT As QueryTable
& & With ActiveSheet
& && &&&Set QT = .QueryTables.Add(&URL;&, .Range(&A1&))
& & End With
& & QT.Refresh False
阅读权限50
在线时间 小时
請參閲附件。
17:15 上传
点击文件名下载附件
9.06 KB, 下载次数: 22
阅读权限20
在线时间 小时
請參閲附件。
非常感谢，网页是转入到表格内了，但能否精简一下，就是只有个股明细，其他的都不要
如图保留最上面的蓝色区域
_200932.png (105.01 KB, 下载次数: 0)
20:11 上传
阅读权限30
在线时间 小时
Sub GetStockDetail()
& & Dim Adr$, sCode$, sDate$, r%
& &
& & Adr = &/soft/stock/StockDetail.aspx?&
& & sCode = [B3].Value
& & sDate = Format([B4].Value, &yyyy-mm-dd&)
& & Adr = Adr & &code=& & sCode
& & Adr = Adr & &&date=& & sDate
& &
& & With Range(&A7&).Resize(100, 20)
& && &&&.ClearContents
& && &&&.Borders.LineStyle = xlNone
& & End With
& & Set HTML = CreateObject(&htmlfile&)
& & With CreateObject(&msxml2.xmlhttp&)
& && &&&.Open &get&, Adr, False
& && &&&.send
& && &&&HTML.body.innerhtml = .responsetext
& && &&&
& && &&&r = 7
& && &&&Set tb = HTML.all.tags(&table&)(0).Rows
& && &&&For i = 0 To tb.Length - 1
& && && && &For j = 0 To tb(i).Cells.Length - 1
& && && && && & Cells(i + r, j + 1) = tb(i).Cells(j).innertext
& && && && &Next
& && &&&Next
& && &&&Range(Cells(8, 1), Cells(i + r - 1, j)).Borders.LineStyle = xlContinuous
& && &&&
& && &&&r = i + 7 + 1
& && &&&Set tb = HTML.all.tags(&table&)(1).Rows
& && &&&For i = 0 To tb.Length - 1
& && && && &For j = 0 To tb(i).Cells.Length - 1
& && && && && & Cells(i + r, j + 1) = tb(i).Cells(j).innertext
& && && && &Next
& && &&&Next
& && &&&
& && &&&'下面调整格式而已
& && &&&r = r - 1
& && &&&Range(Cells(i + r, 3), Cells(i + r, j + 1)) = Range(Cells(i + r, 2), Cells(i + r, j)).Value
& && &&&Cells(i + r, 2) = &&
& && &&&Range(Cells(r + 2, 1), Cells(i + r, j + 1)).Borders.LineStyle = xlContinuous
& && &&&
& && &&&Union(Cells(i + r, 3), Cells(i + r, 5)).NumberFormatLocal = &G/通用格式&
& & End With
End Sub
复制代码
21:42 上传
点击文件名下载附件
19.08 KB, 下载次数: 26
优秀作品 ,，太强大了，非常非常感谢！！！
阅读权限50
在线时间 小时
Sub test()
& & Dim QT As QueryTable
& & With ActiveSheet
& && &&&Set QT = .QueryTables.Add(&URL;&, .Range(&A1&))
& & End With
& & With QT
& && &&&.WebTables = &1,2&
& && &&&.Refresh False
& & End With
优秀作品 ,，太强大了，非常非常感谢！！！
阅读权限50
在线时间 小时
請參閲附件。
23:03 上传
点击文件名下载附件
9.36 KB, 下载次数: 22
优秀作品 ,，太强大了，非常非常感谢！！！
阅读权限20
在线时间 小时
非常非常感谢两位老师！！！你们太强大 了！！！
阅读权限20
在线时间 小时
_165523.png (23.65 KB, 下载次数: 0)
16:56 上传
老师好，请教您一下：
如何将表头也弄到excel中呢？我找不到这些文字……
表头内容：
星期五 类型：当日涨幅偏离值达7%的证券收盘价：18.32元& &&&涨跌幅：10.03%& &&&成交量：3244.51万股& &&&成交金额：58853.41万元
阅读权限20
在线时间 小时
老师好，请教您一下：
如何将表头也弄到excel中呢？我找不到这些文字……
最新热点 /1
ExcelHome每周都有线上直播公开课，
国内一流讲师真身分享，高手贴身答疑，
赶不上直播还能看录像，
关键居然是免费的！
厚木哥们都已经这么努力了，
你还好意思说学不好Office。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 12431|回复: 22
请教老师 东方财富网 股票数据 怎么下
阅读权限30
在线时间 小时
& & 请教老师 东方财富网
股票数据 怎么下？
下A股一个数据要半天几个小时，不得不放弃
用& & Cells(12, c) & &.html
补充内容 ( 11:07):
本贴问题 在老师的帮助下，已解决
[求助] 请教老师 东方财富网 股票数据 怎么下
怎么将 1楼的[求助] 改成[已解决] ？？
哪过路过的朋友点一下
阅读权限30
在线时间 小时
今天再顶一下
阅读权限30
在线时间 小时
找了一个例子
引子玄 老师在第三楼，作的解答能帮我一下就好了
阅读权限30
在线时间 小时
本帖最后由 jinsha2002 于
09:43 编辑
by&&引子玄 发表于
00:05:30&&
Sub 第100页的提取() '注意:红色部分为相对路径
With CreateObject(&InternetExplorer.Application&)
& && &&&.Visible = False
& && &&&.Navigate &/NoticeBoard/xianji/XianJi_NiBidInfo.aspx&
& && &&&Do Until .ReadyState = 4
& && && && &DoEvents
& && &&&Loop
& && && &&&.Navigate &javascript:__doPostBack('ctl00$ContentPlaceHolder1$pager1','100')&
& && && && &Do Until .ReadyState = 4
& && && && &DoEvents
& && && && &Loop
& && &a = .Document.All.tags(&table&)(3).outerhtml
& && &MsgBox a
& && &Call makelog(a, &C:\Documents and Settings\Administrator\桌面\本地COOKIE&, &txt&) '注意:红色部分是相对路径
&&End With
& && &With ActiveSheet.QueryTables.Add(Connection:= _
& && &&&&URL;file:///C:/Documents%20and%20Settings/Administrator/桌面/本地COOKIE/log.txt&, _
& && &&&Destination:=Range(&A1&))
& && &&&.Name = &log&
& && &&&.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 = &&&ctl00_ContentPlaceHolder1_gvwAppraiseInfo&&&
& && &&&.WebPreFormattedTextToColumns = True
& && &&&.WebConsecutiveDelimitersAsOne = True
& && &&&.WebSingleBlockTextImport = False
& && &&&.WebDisableDateRecognition = False
& && &&&.WebDisableRedirections = False
& && &&&.Refresh BackgroundQuery:=False
& & End With
& & [a:a].ColumnWidth = 15
Private Sub makelog(inputed_string, log_path, filetype)
& &Dim objFSO, logfile, logtext, log_folder
& &Set objFSO = CreateObject(&Scripting.FileSystemObject&)
& &On Error Resume Next
& &Set log_folder = objFSO.CreateFolder(log_path)
& &If objFSO.FileExists(log_path & &\log.& & filetype) = 0 Then
& && & Set logfile = objFSO.CreateTextFile(log_path & &\log.& & filetype, True, -1)
& &Set log_folder = Nothing
& &Set logfile = Nothing
& &Set logtext = objFSO.OpenTextFile(log_path & &\log.& & filetype, 2, True, -1)
& &logtext.Write inputed_string
& &logtext.Close
& &Set objFSO = Nothing
阅读权限30
在线时间 小时
& & & & & & & &
.Navigate &javascript:__doPostBack('ctl00$ContentPlaceHolder1$pager1','100')&
引子玄 老师这句是怎么来的？
阅读权限30
在线时间 小时
&a href=&javascript:__doPostBack('ctl00$ContentPlaceHolder1$pager1','2')&&下一页&/a&
【当前 第 1 页　共 1488 页　计 22309 条】 转到第&select id='pager'&
可能是老师分析了网页代码 找到了
{:soso_e128:}
阅读权限30
在线时间 小时
& & & & & & & &
东方财富网
股票数据 中 下一页 javascript:; 这表是什么
阅读权限30
在线时间 小时
请教老师 东方财富网
股票数据 怎么下？
为什么在 东方财富网 的网页代码 中找不到 下一页的 Navigate
阅读权限30
在线时间 小时
请路过的朋友，帮忙顶一下，好让老师看到
阅读权限30
在线时间 小时
顶一下，好好学习。
最新热点 /1
ExcelHome每周都有线上直播公开课，
国内一流讲师真身分享，高手贴身答疑，
赶不上直播还能看录像，
关键居然是免费的！
厚木哥们都已经这么努力了，
你还好意思说学不好Office。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 12431|回复: 22
请教老师 东方财富网 股票数据 怎么下
阅读权限30
在线时间 小时
& & 请教老师 东方财富网
股票数据 怎么下？
下A股一个数据要半天几个小时，不得不放弃
用& & Cells(12, c) & &.html
补充内容 ( 11:07):
本贴问题 在老师的帮助下，已解决
[求助] 请教老师 东方财富网 股票数据 怎么下
怎么将 1楼的[求助] 改成[已解决] ？？
哪过路过的朋友点一下
阅读权限30
在线时间 小时
今天再顶一下
阅读权限30
在线时间 小时
找了一个例子
引子玄 老师在第三楼，作的解答能帮我一下就好了
阅读权限30
在线时间 小时
本帖最后由 jinsha2002 于
09:43 编辑
by&&引子玄 发表于
00:05:30&&
Sub 第100页的提取() '注意:红色部分为相对路径
With CreateObject(&InternetExplorer.Application&)
& && &&&.Visible = False
& && &&&.Navigate &/NoticeBoard/xianji/XianJi_NiBidInfo.aspx&
& && &&&Do Until .ReadyState = 4
& && && && &DoEvents
& && &&&Loop
& && && &&&.Navigate &javascript:__doPostBack('ctl00$ContentPlaceHolder1$pager1','100')&
& && && && &Do Until .ReadyState = 4
& && && && &DoEvents
& && && && &Loop
& && &a = .Document.All.tags(&table&)(3).outerhtml
& && &MsgBox a
& && &Call makelog(a, &C:\Documents and Settings\Administrator\桌面\本地COOKIE&, &txt&) '注意:红色部分是相对路径
&&End With
& && &With ActiveSheet.QueryTables.Add(Connection:= _
& && &&&&URL;file:///C:/Documents%20and%20Settings/Administrator/桌面/本地COOKIE/log.txt&, _
& && &&&Destination:=Range(&A1&))
& && &&&.Name = &log&
& && &&&.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 = &&&ctl00_ContentPlaceHolder1_gvwAppraiseInfo&&&
& && &&&.WebPreFormattedTextToColumns = True
& && &&&.WebConsecutiveDelimitersAsOne = True
& && &&&.WebSingleBlockTextImport = False
& && &&&.WebDisableDateRecognition = False
& && &&&.WebDisableRedirections = False
& && &&&.Refresh BackgroundQuery:=False
& & End With
& & [a:a].ColumnWidth = 15
Private Sub makelog(inputed_string, log_path, filetype)
& &Dim objFSO, logfile, logtext, log_folder
& &Set objFSO = CreateObject(&Scripting.FileSystemObject&)
& &On Error Resume Next
& &Set log_folder = objFSO.CreateFolder(log_path)
& &If objFSO.FileExists(log_path & &\log.& & filetype) = 0 Then
& && & Set logfile = objFSO.CreateTextFile(log_path & &\log.& & filetype, True, -1)
& &Set log_folder = Nothing
& &Set logfile = Nothing
& &Set logtext = objFSO.OpenTextFile(log_path & &\log.& & filetype, 2, True, -1)
& &logtext.Write inputed_string
& &logtext.Close
& &Set objFSO = Nothing
阅读权限30
在线时间 小时
& & & & & & & &
.Navigate &javascript:__doPostBack('ctl00$ContentPlaceHolder1$pager1','100')&
引子玄 老师这句是怎么来的？
阅读权限30
在线时间 小时
&a href=&javascript:__doPostBack('ctl00$ContentPlaceHolder1$pager1','2')&&下一页&/a&
【当前 第 1 页　共 1488 页　计 22309 条】 转到第&select id='pager'&
可能是老师分析了网页代码 找到了
{:soso_e128:}
阅读权限30
在线时间 小时
& & & & & & & &
东方财富网
股票数据 中 下一页 javascript:; 这表是什么
阅读权限30
在线时间 小时
请教老师 东方财富网
股票数据 怎么下？
为什么在 东方财富网 的网页代码 中找不到 下一页的 Navigate
阅读权限30
在线时间 小时
请路过的朋友，帮忙顶一下，好让老师看到
阅读权限30
在线时间 小时
顶一下，好好学习。
最新热点 /1
ExcelHome每周都有线上直播公开课，
国内一流讲师真身分享，高手贴身答疑，
赶不上直播还能看录像，
关键居然是免费的！
厚木哥们都已经这么努力了，
你还好意思说学不好Office。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师