20170729xlVba SSC_RECENT100

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