20170728xlVba SSC_LastTwoDays

Public Sub SSCLastTwoDays()

    Dim strText As String

    Dim Reg As Object, Mh As Object, OneMh As Object

    Dim i As Long

    Set Reg = CreateObject("Vbscript.Regexp")

    With Reg

        .MultiLine = True

        .Global = True

        .Ignorecase = False

        'class='gray'>007</td><td class='red big'>78018</td>

        .Pattern = "(>)(\d{3})(?:</td><td class='red big'>)(\d{5})(?:</td>)"

    End With

    Dim Today As String, Yesterday As String

    Yesterday = Format(DateAdd("d", -1, Now()), "yyyy-mm-dd")

    With CreateObject("MSXML2.XMLHTTP")

        .Open "GET", "http://chart.cp.360.cn/kaijiang/kaijiang?lotId=255401&spanType=2&span=" & Yesterday & "_" & Yesterday, False

        .Send

        strText = .responsetext

    End With

    Set Mh = Reg.Execute(strText)

    With Sheets(1)

        .Cells.ClearContents

        .Range("A1:N1").Value = Array("大期号", "小期号", "万", "千", "百", "十", "个", "后三", "组01", "组23", "组45", "组67", "组89", "预测")

        Index = 1

        For Each OneMh In Mh

            Index = Index + 1

            .Cells(Index, 1).Value = "'" & Format(Yesterday, "yyyymmdd") & OneMh.submatches(1)

            .Cells(Index, 2).Value = OneMh.submatches(1)

            op = OneMh.submatches(2)

            For j = 1 To Len(op)

                .Cells(Index, j + 2).Value = Mid(op, j, 1)

            Next j

            .Cells(Index, 8).Value = "'" & Right(op, 3)

        Next OneMh

    End With

    Today = Format(Now, "yyyy-mm-dd")

    With CreateObject("MSXML2.XMLHTTP")

        .Open "GET", "http://chart.cp.360.cn/kaijiang/kaijiang?lotId=255401&spanType=2&span=" & Today & "_" & Today, False

        .Send

        strText = .responsetext

    End With

    Set Mh = Reg.Execute(strText)

    With Sheets(1)

        For Each OneMh In Mh

            Index = Index + 1

            .Cells(Index, 1).Value = "'" & Format(Today, "yyyymmdd") & OneMh.submatches(1)

            .Cells(Index, 2).Value = OneMh.submatches(1)

            op = OneMh.submatches(2)

            For j = 1 To Len(op)

                .Cells(Index, j + 2).Value = Mid(op, j, 1)

            Next j

            .Cells(Index, 8).Value = "'" & Right(op, 3)

        Next OneMh

    End With

    With Sheets(1)

        Sort2003 .UsedRange, 2

        For i = 2 To Index

            s = .Cells(i, 8).Text

            gua = 0

            For j = 9 To 13

                keys = Replace(.Cells(1, j).Text, "组", "")

                key1 = Left(keys, 1)

                key2 = Right(keys, 1)

                'Debug.Print s; "   "; keys

                If InStr(1, s, key1) = 0 And InStr(1, s, key2) = 0 Then

                    .Cells(i, j).Value = "中"

                Else

                    .Cells(i, j).Value = "挂"

                    gua = gua + 1

                End If

            Next j

            If gua >= 3 Then

                .Cells(i, 14).Value = "挂"

            Else

                .Cells(i, 14).Value = "中"

            End If

        Next i

        With .UsedRange

            .HorizontalAlignment = xlCenter

            .VerticalAlignment = xlBottom

        End With

        SetBorders .UsedRange

        Dim uRng As Range

        Dim OneCell As Range

        For Each OneCell In .UsedRange.Cells

            If OneCell.Text = "中" Then

                If uRng Is Nothing Then

                    Set uRng = OneCell

                Else

                    Set uRng = Union(uRng, OneCell)

                End If

            End If

        Next OneCell

        FillRed uRng

    End With

    Set Reg = Nothing

    Set Mh = Nothing

    Set uRng = Nothing

End Sub

Sub Sort2003(ByVal RngWithTitle As Range, Optional SortColumnNo As Long = 1)

    With RngWithTitle

        .Sort key1:=RngWithTitle.Cells(1, SortColumnNo), Order1:=xlAscending, Header:=xlYes, _

              MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin

    End With

End Sub

Sub SetBorders(ByVal Rng As Range)

    With Rng.Borders

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .Weight = xlThin

    End With

End Sub

Sub FillRed(ByVal Rng As Range)

    With Rng.Font

        .ColorIndex = 3

        .Bold = True

    End With

End Sub