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. python 读写压缩文件

    gzip 和bz2 模块可以很容易的处理这些文件.两个模块都为open() 函数提供了另外的实现来解决这个问题.比如,为了以文本形式读取压缩文件,可以这样做: # gzip compression i ...

  2. MyBatis学习笔记(三)——优化MyBatis配置文件中的配置

    转自孤傲苍狼的博客:http://www.cnblogs.com/xdp-gacl/p/4264301.html 一.连接数据库的配置单独放在一个properties文件中 之前,我们是直接将数据库的 ...

  3. Java一元操作符++详解

    废话不多说,直接上代码. package com.coshaho.learn; /** * * OperatorLearn.java Create on 2016-11-13 下午8:38:15 * ...

  4. 20145316许心远《网络对抗》MSF基础应用

    20145316许心远<网络对抗>MSF基础应用 实验后回答问题 用自己的话解释什么是exploit,payload,encode. exploit:顾名思义就是攻击嘛,因为是个动词,所以 ...

  5. tomcat 9.0.4 性能调优

    参考了网上的一些优化参数,但是在启动中发现 有2个报错: 11-Feb-2018 15:57:23.293 警告 [main] org.apache.catalina.startup.SetAllPr ...

  6. CentOS随笔 - 4.CentOS7安装MySql 5.5.60(下载 tar 方式安装)

    前言 转帖请注明出处: http://www.cnblogs.com/Troy-Lv5/ 由于公司也有php+mysql的项目, 所以今天也把Mysql装了一遍. 为了与以前的程序和数据库兼容, 这次 ...

  7. Fast特征点的寻找和提取

    一.基础 最初由Rosten和Drummond [Rosten06]提出的FAST(加速段测试的特征)特征检测算法是基于将点P与其包围圆内的点集的直接比较的思想. 基本思想是,如果附近的几个点与P类似 ...

  8. 《Python程序设计(第3版)》[美] 约翰·策勒(John Zelle) 第 4 章 答案

    判断对错 1.利用 grAphiCs.py 可以在 Python 的 shell 窗口中绘制图形.2.传统上,图形窗口的左上角坐标为(0,0).3.图形屏幕上的单个点称为像素.4.创建类的新实例的函数 ...

  9. Timer,TimerTask,Handler

    新建一个定时器线程,通过此线程每一秒发送数据到Handler,然后通过Handler来修改UI. 1.获得Handler,Timer,TimerTask对象. Handler handler=new ...

  10. Python3基础 try-except else进行配合

             Python : 3.7.0          OS : Ubuntu 18.04.1 LTS         IDE : PyCharm 2018.2.4       Conda ...