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. REST服务安全-双向认证

    1. 创建服务器密钥,其密钥库为 d:/mykeys/server.ks,注意keypass和storepass保持一致,它们分别代表 密钥密码和密钥库密码,注意 CN=localhost 中,loc ...

  2. web测试项目总结

    一.输入框 1.字符型输入框: (1)字符型输入框:英文全角.英文半角.数字.空或者空格.特殊字符“~!@#¥%……&*?[]{}”特别要注意单引号和&符号.禁止直接输入特殊字符时,使 ...

  3. P4052 [JSOI2007]文本生成器

    P4052 [JSOI2007]文本生成器 AC自动机+dp 优秀题解传送门 设f[ i ][ j ]表示串的长度为 i ,当前在 j 点时不可识别的串的方案数 最后用总方案数减去不可识别方案数就是答 ...

  4. 利用Python网络爬虫爬取学校官网十条标题

    利用Python网络爬虫爬取学校官网十条标题 案例代码: # __author : "J" # date : 2018-03-06 # 导入需要用到的库文件 import urll ...

  5. kafka调试遇到的问题

    在三台机器上以不同的端口部署了三个kafka和zookeeper实例,对应三套环境. 如: zk1:2181 zk2:2182 zk3:2183 kafka1:9092 kafka2:9093 kaf ...

  6. centos+Jenkins+maven搭建持续集成

    Jenkins是一个开源软件项目,旨在提供一个开放易用的软件平台,使软件的持续集成变成可能 什么是持续集成 随着软件开发复杂度的不断提高,团队开发成员间如何更好地协同工作以确保软件开发的质量已经慢慢成 ...

  7. Java第一次实验 20145104张家明

    Java第一次实验 实验报告 实验要求: 1.使用JDK编译.运行简单的Java程序 2.使用IDEA 编辑.编译.运行.调试Java程序 实验内容: 1.使用JDK编译.运行简单的Java程序: 2 ...

  8. 20145222何志威《网络对抗》- Web安全基础实践

    20145322何志威<网络对抗>Exp9 Web安全基础实践 基础问题回答 1.SQL注入原理,如何防御 SQL注入 就是通过把SQL命令插入到"Web表单递交"或& ...

  9. 20165310 java_blog_week5

    # 2165310 <Java程序设计>第5周学习总结 教材学习内容总结 ch07内部类与异常类 内部类 - 继承外嵌类成员变量与方法 - 不可以声明类变量/类方法 - 不可以被外嵌类以外 ...

  10. 移动页面click延迟引发的touch问题

    一.事件捕获与冒泡 先扯一下事件的触发流程,这个之后会用到. DOM2级事件规定事件包括三个阶段: ① 事件捕获阶段 ② 处于目标阶段 ③ 事件冒泡阶段 大概的流程就是事件从最外层一层一层往里面传递( ...