Public Sub Recent100() Dim WebText As String Dim Reg As Object, Mh As Object, OneMh As Object Dim i As Long, j As Long, Nums As String Set Reg = CreateObject("Vbscript.Regexp") With Reg .MultiLine = True .Global = True .Ignorecase = False '20170728013</td><td class='z_bg_13'>07627</td>'审查元素,获取目标字符串 .Pattern = "(d{11})(<)(?:/td><td class='z_bg_13'>)(d{5})(?:</td>)" End With With CreateObject("WinHttp.WinHttpRequest.5.1") 'CreateObject("MSXML2.XMLHTTP")'受缓存影响不能及时更新 '.Open "GET", "http://chart.cp.360.cn/kaijiang/kaijiang?lotId=255401&spanType=2&span=" & Yesterday & "_" & Yesterday, False'更新指定日期 .Open "GET", "http://zst.cjcp.com.cn/cjwssc/view/ssc_zusan-ssc-0-3-100.html", False .Send WebText = .responsetext End With Set Mh = Reg.Execute(WebText) With Sheets(2) .Cells.Clear .Range("A1:G1").Value = Array("大期号", "小期号", "万", "千", "百", "十", "个") i = 1 For Each OneMh In Mh i = i + 1 .Cells(i, 1).Value = "'" & OneMh.submatches(0) .Cells(i, 2).Value = "'" & Right(OneMh.submatches(0), 3) Nums = OneMh.submatches(2) For j = 1 To Len(Nums) .Cells(i, j + 2).Value = Mid(Nums, j, 1) Next j Next OneMh With .UsedRange .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With SetBorders .UsedRange End With Set Reg = Nothing Set Mh = Nothing End Sub Sub SetBorders(ByVal Rng As Range) With Rng.Borders .LineStyle = xlContinuous .ColorIndex = xlAutomatic .Weight = xlThin End With End Sub