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 ...
随机推荐
- 安装rocketmq-console
一.alibaba版本 使用rocketmq命令查看集群状态,查看topic信息时比较麻烦,而且不直观,这个时候可以使用一些web页面来管理rocketmq. 以前曾使用过一个老版本的工具,适用于al ...
- git仓库按时间、成员等维度分析统计
git 按时间打印所有成员代码提交: git log --since ==2018-01-01 --until=2018-12-31 --format='%aN' | sort -u | while ...
- bzoj4591 / P4345 [SHOI2015]超能粒子炮·改
P4345 [SHOI2015]超能粒子炮·改 题意:求$\sum_{i=1}^{k}C(n,i)\%(P=2333)$ 肯定要先拆开,不然怎么做呢(大雾) 把$C(n,i)$用$lucas$分解一下 ...
- Java HSSFworkbook,XSSFworkbook,SXSSFworkbook区别简述
Java HSSFworkbook,XSSFworkbook,SXSSFworkbook区别简述 一.HSSFworkbook,XSSFworkbook,SXSSFworkbook区别简述 用Java ...
- 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 ...
- python程序转为exe文件
python开发者向普通windows用户分享程序,要给程序加图形化的界面(传送门:这可能是最好玩的python GUI入门实例! http://www.jianshu.com/p/8abcf73ad ...
- C# 获取当前IIS请求地址
using System;using System.Collections.Generic;using System.Linq;using System.Web; /// <summary> ...
- jquery hover最后解决 - 不再疑惑 - 例子在这里
hover具有动画累计的bug, 可以使用 stop 或 filter(:not(:animated))来消除, 但是, 即使这样, 当鼠标反复滑入或滑出的时候, 虽然没有动画累计的问题, 但是 下面 ...
- [BZOJ1103][POI2007]大都市meg dfs序+树状数组
Description 在经济全球化浪潮的影响下,习惯于漫步在清晨的乡间小路的邮递员Blue Mary也开始骑着摩托车传递邮件了.不过,她经常回忆起以前在乡间漫步的情景.昔日,乡下有依次编号为1..n ...
- 【TCP/IP详解 卷一:协议】TCP定时器 小结
前言 在有关TCP的章节中,介绍了四种定时器,它们体现了TCP的可靠性,其中最重要的 就是重传定时器了,剩下的定时器都是为了解决TCP的理解上的一些问题而设置的. 四种定时器: 2MSL定时器,出现在 ...