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
20170728xlVba SSC_LastTwoDays的更多相关文章
- 20170728xlVba还是这个混蛋
Public Sub Main22() If Now() >= #1/1/2018# Then Exit Sub Dim strText As String Dim Reg As Object, ...
- 20170728xlVba SSC_TODAY
Public Sub SSC_TODAY() Dim strText As String Dim Reg As Object, Mh As Object, OneMh As Object Dim i ...
- 20170728xlVba简单的匹配
Sub MatchData() Dim i As Long, EndRow As Long, Key As String Dim Rng As Range Dim Dic As Object Set ...
- 20170728xlVBA改转置一例
Sub 导出() Dim Sht As Worksheet, ShtName As String Dim NextRow As Long, NextRow2 As Long Dim iRow As L ...
随机推荐
- python 读写压缩文件
gzip 和bz2 模块可以很容易的处理这些文件.两个模块都为open() 函数提供了另外的实现来解决这个问题.比如,为了以文本形式读取压缩文件,可以这样做: # gzip compression i ...
- MyBatis学习笔记(三)——优化MyBatis配置文件中的配置
转自孤傲苍狼的博客:http://www.cnblogs.com/xdp-gacl/p/4264301.html 一.连接数据库的配置单独放在一个properties文件中 之前,我们是直接将数据库的 ...
- Java一元操作符++详解
废话不多说,直接上代码. package com.coshaho.learn; /** * * OperatorLearn.java Create on 2016-11-13 下午8:38:15 * ...
- 20145316许心远《网络对抗》MSF基础应用
20145316许心远<网络对抗>MSF基础应用 实验后回答问题 用自己的话解释什么是exploit,payload,encode. exploit:顾名思义就是攻击嘛,因为是个动词,所以 ...
- tomcat 9.0.4 性能调优
参考了网上的一些优化参数,但是在启动中发现 有2个报错: 11-Feb-2018 15:57:23.293 警告 [main] org.apache.catalina.startup.SetAllPr ...
- CentOS随笔 - 4.CentOS7安装MySql 5.5.60(下载 tar 方式安装)
前言 转帖请注明出处: http://www.cnblogs.com/Troy-Lv5/ 由于公司也有php+mysql的项目, 所以今天也把Mysql装了一遍. 为了与以前的程序和数据库兼容, 这次 ...
- Fast特征点的寻找和提取
一.基础 最初由Rosten和Drummond [Rosten06]提出的FAST(加速段测试的特征)特征检测算法是基于将点P与其包围圆内的点集的直接比较的思想. 基本思想是,如果附近的几个点与P类似 ...
- 《Python程序设计(第3版)》[美] 约翰·策勒(John Zelle) 第 4 章 答案
判断对错 1.利用 grAphiCs.py 可以在 Python 的 shell 窗口中绘制图形.2.传统上,图形窗口的左上角坐标为(0,0).3.图形屏幕上的单个点称为像素.4.创建类的新实例的函数 ...
- Timer,TimerTask,Handler
新建一个定时器线程,通过此线程每一秒发送数据到Handler,然后通过Handler来修改UI. 1.获得Handler,Timer,TimerTask对象. Handler handler=new ...
- Python3基础 try-except else进行配合
Python : 3.7.0 OS : Ubuntu 18.04.1 LTS IDE : PyCharm 2018.2.4 Conda ...