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】Python 网页爬虫 & 文本处理 & 科学计算 & 机器学习 & 数据挖掘兵器谱
本文转载自:https://www.cnblogs.com/colipso/p/4284510.html 好文 mark http://www.52nlp.cn/python-%E7%BD%91%E9 ...
- ubuntu14.04无法安装Curl,需要先升级sudo apt-get update
ubuntu14.04无法安装Curl,需要先升级sudo apt-get updatesudo apt-get updatesudo apt-get install curl------------ ...
- MySQL数据库----安装
一.基础部分 1.数据库是什么 之前所学,数据要永久保存,比如用户注册的用户信息,都是保存于文件中,而文件只能存在于某一台机器上. 如果我们不考虑从文件中读取数据的效率问题,并且假设我们的程序所有的组 ...
- YAML配置文件
最近,研究jeeweb这个框架,发现新版本中的配置文件都是用的.yml为后缀的文件,打开一看,和以前的xml和properties语法有很大区别,因此仔细研究一下. 简介: YAML是(YAML Ai ...
- centos下gitlab私服完整安装部署(nginx+MySQL+redis+gitlab-ce+gitlab-shell+)
系统环境cat /etc/redhat-release CentOS release 6.8 (Final) nginx -vnginx version: nginx/1.9.15 redis-cli ...
- Nodejs 实现 WebSocket 太容易了吧!!
我们基于express和socket.io开发,首先我们需要安装以下包 npm install --save express npm install --save socket.io 服务器端代码: ...
- Bootloader之uBoot简介
本文转载自:http://blog.ednchina.com/hhuwxf/1915416/message.aspx 一.Bootloader的引入 从前面的硬件实验可以知道,系统上电之后,需要一段程 ...
- dp暑假专题 训练记录
A 回文串的最小划分 题意:给出长度不超过1000的字符串,把它分割成若干个回文字串,求能分成的最少字串数. #include <iostream> #include <cstdio ...
- 初始 DQN 程序 所遇到的问题
初始 DQN 程序 所遇到的问题 最近在看 DQN,但是想试试别人放出来的 code,但是发现,额,各种问题,在此记录,以备不时之需! 问题1. wangxiao@GTX980:~/Documents ...
- IntelliJ IDEA问题总结
在使用Idea的过程中,会遇到各种各样的问题,下面我将在这里持续总结: 1.Unable to import maven project: See logs for details 在遇到这个问题时, ...