财务数据看哪些指标 网握：VBA赢得融会信龙虎榜单页面笔墨执行到EXCEL
发布日期：2024-12-15 08:23 点击次数：105
赢得文本执行，蚁合正则抒发式，分析数据到表格。
Option Explicit
Private Sub CommandButton1_Click()
Dim N As Long
Dim str As String
Dim mStr As String
Dim regEx As Object
Dim Match As Object
Dim Matchs As Object
str = GetstrSource1('001319') '赢得文本
Set regEx = CreateObject('vbscript.regexp')
regEx.Global = True '全局灵验
regEx.MultiLine = True '多行灵验
regEx.IgnoreCase = True '忽略大小写
regEx.Pattern = '\[\[[\s\S]*?\]]'
str = regEx.Execute(str).Item(0)
regEx.Pattern = '\[[\s\S]*?\]'
Set Match = regEx.Execute(str)
Dim zDate As String
For N = 1 To Match.Count
mStr = Match.Item(N - 1) '执行
mStr = Replace(mStr, 'null', Chr(34) & Chr(34))
mStr = Replace(Replace(mStr, 'B', '买入'), 'S', '卖出')
mStr = Replace(Replace(mStr, 'dr', '当日'), '3r', '3日')
regEx.Pattern = '''[\s\S]*?'''
Set Matchs = regEx.Execute(mStr)
Cells(N + 3, 1) = NewStock(Replace(Matchs.Item(1), Chr(34), ''))
Cells(N + 3, 2) = Replace(Matchs.Item(0), Chr(34), '')
Cells(N + 3, 3) = Replace(Matchs.Item(2), Chr(34), '')
Cells(N + 3, 4) = Replace(Matchs.Item(3), Chr(34), '')
Cells(N + 3, 5) = Replace(Matchs.Item(4), Chr(34), '')
Cells(N + 3, 6) = Replace(Matchs.Item(5), Chr(34), '')
Cells(N + 3, 7) = Replace(Matchs.Item(6), Chr(34), '')
Cells(N + 3, 8) = Replace(Matchs.Item(7), Chr(34), '')
Cells(N + 3, 9) = Replace(Matchs.Item(8), Chr(34), '')
zDate = Replace(Matchs.Item(9), Chr(34), '')
Cells(N + 3, 10) = Format(CDate(zDate), ' yyyy-mm-dd')
Next N
End Sub
Private Function GetstrSource1(sCode As String) As String
Dim Url As String
Url = 'http://page.tdx.com.cn:7615/TQLEX?Entry=CWServ.cfg_fx_yzlhb'
Dim strSend As String
strSend = '{''Params'':['
strSend = strSend & '''yybxq'','
strSend = strSend & ''''',' & ''''','
strSend = strSend & '''' & sCode & ''','
strSend = strSend & ''''',' & '0,20]}'
'{'Params':['yybxq','','','001319','',0,20]}
With CreateObject('MSXML2.XMLHTTP')
.Open 'POST', Url, False
.send CStr(strSend)
GetstrSource1 = StrConv(.responseText, vbNarrow)
End With
End Function
Private Function NewStock(strStock As String) As String
Select Case Left(strStock, 2)
Case '60', '68', '11'
NewStock = 'sh' & Replace(strStock, Chr(34), '')
Case '00', '30', '12'
NewStock = 'sz' & Replace(strStock, Chr(34), '')
Case Else
NewStock = 'bj' & Replace(strStock, Chr(34), '')
End Select
End Function
本站仅提供存储处事，通盘执行均由用户发布，如发现存害或侵权执行，请点击举报。
