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