20170728xlVba还是这个混蛋

Public Sub Main22()
    If Now() >= #1/1/2018# Then Exit Sub
    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>)"
        ‘20170728013</td><td class=‘z_bg_13‘>07627</td>
        .Pattern = "(\d{11})(<)(?:/td><td class=‘z_bg_13‘>)(\d{5})(?:</td>)"

    End With

      
    Dim Today As String, Yesterday As String


    Yesterday = Format(DateAdd("d", -1, Now()), "yyyy-mm-dd")
    ‘Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    ‘WinHttp.WinHttpRequest
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        ‘.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
        
        strText = .responsetext
    End With
    
    ‘Debug.Print strText
    ‘strText = JSEval(strText)
    Set Mh = Reg.Execute(strText)



    With Sheets(1)
        .Cells.Clear
        .Range("A1:N1").Value = Array("大期号", "小期号", "万", "千", "百", "十", "个", "后三", "组01", "组23", "组45", "组67", "组89", "预测")
        Index = 1
        For Each OneMh In Mh
            Index = Index + 1
            .Cells(Index, 1).Value = "‘" & OneMh.submatches(0)
            .Cells(Index, 2).Value = "‘" & Right(OneMh.submatches(0), 3)
            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


        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
‘Set xmlhttp = 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

Function JSEval(s As String) As String
    With CreateObject("MSScriptControl.ScriptControl")
        .Language = "javascript"
        JSEval = .Eval(s)
    End With
End Function