江苏期货配资 网抓:VBA获取通达信龙虎榜单页面文字内容到EXCEL

发布日期:2025-01-07 15:19    点击次数:205

江苏期货配资 网抓:VBA获取通达信龙虎榜单页面文字内容到EXCEL

获取文本内容,结合正则表达式,分析数据到表格。 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 本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请点击举报。