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

  

20170728xlVba SSC_LastTwoDays的更多相关文章

  1. 20170728xlVba还是这个混蛋

    Public Sub Main22() If Now() >= #1/1/2018# Then Exit Sub Dim strText As String Dim Reg As Object, ...

  2. 20170728xlVba SSC_TODAY

    Public Sub SSC_TODAY() Dim strText As String Dim Reg As Object, Mh As Object, OneMh As Object Dim i ...

  3. 20170728xlVba简单的匹配

    Sub MatchData() Dim i As Long, EndRow As Long, Key As String Dim Rng As Range Dim Dic As Object Set ...

  4. 20170728xlVBA改转置一例

    Sub 导出() Dim Sht As Worksheet, ShtName As String Dim NextRow As Long, NextRow2 As Long Dim iRow As L ...

随机推荐

  1. 安装rocketmq-console

    一.alibaba版本 使用rocketmq命令查看集群状态,查看topic信息时比较麻烦,而且不直观,这个时候可以使用一些web页面来管理rocketmq. 以前曾使用过一个老版本的工具,适用于al ...

  2. git仓库按时间、成员等维度分析统计

    git 按时间打印所有成员代码提交: git log --since ==2018-01-01 --until=2018-12-31 --format='%aN' | sort -u | while ...

  3. bzoj4591 / P4345 [SHOI2015]超能粒子炮·改

    P4345 [SHOI2015]超能粒子炮·改 题意:求$\sum_{i=1}^{k}C(n,i)\%(P=2333)$ 肯定要先拆开,不然怎么做呢(大雾) 把$C(n,i)$用$lucas$分解一下 ...

  4. Java HSSFworkbook,XSSFworkbook,SXSSFworkbook区别简述

    Java HSSFworkbook,XSSFworkbook,SXSSFworkbook区别简述 一.HSSFworkbook,XSSFworkbook,SXSSFworkbook区别简述 用Java ...

  5. USACO 1.3 Ski Course Design - 暴力

    Ski Course Design Farmer John has N hills on his farm (1 <= N <= 1,000), each with an integer ...

  6. python程序转为exe文件

    python开发者向普通windows用户分享程序,要给程序加图形化的界面(传送门:这可能是最好玩的python GUI入门实例! http://www.jianshu.com/p/8abcf73ad ...

  7. C# 获取当前IIS请求地址

    using System;using System.Collections.Generic;using System.Linq;using System.Web; /// <summary> ...

  8. jquery hover最后解决 - 不再疑惑 - 例子在这里

    hover具有动画累计的bug, 可以使用 stop 或 filter(:not(:animated))来消除, 但是, 即使这样, 当鼠标反复滑入或滑出的时候, 虽然没有动画累计的问题, 但是 下面 ...

  9. [BZOJ1103][POI2007]大都市meg dfs序+树状数组

    Description 在经济全球化浪潮的影响下,习惯于漫步在清晨的乡间小路的邮递员Blue Mary也开始骑着摩托车传递邮件了.不过,她经常回忆起以前在乡间漫步的情景.昔日,乡下有依次编号为1..n ...

  10. 【TCP/IP详解 卷一:协议】TCP定时器 小结

    前言 在有关TCP的章节中,介绍了四种定时器,它们体现了TCP的可靠性,其中最重要的 就是重传定时器了,剩下的定时器都是为了解决TCP的理解上的一些问题而设置的. 四种定时器: 2MSL定时器,出现在 ...