Sub 红球画线()
Application.ScreenUpdating = False
Call 删线
Call 红球大小比走势图
Call 红球奇偶比走势图
Application.ScreenUpdating = True
End Sub
Sub 删线()
Dim hh As Shape
For Each hh In ActiveSheet.Shapes
If hh.Type = 9 Then
hh.Delete
End If
Next
End Sub
Sub 蓝球分布()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("d3:s" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 3).Left + Cells(x + 2, y + 4).Left) / 2
yy1 = (Cells(x + 2, y + 3).Top + Cells(x + 3, y + 5).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 3).Left + Cells(x + 2, y + 4).Left) / 2
yy2 = (Cells(x + 2, y + 3).Top + Cells(x + 3, y + 5).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 蓝球随机四区间()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("v3:y" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 21).Left + Cells(x + 2, y + 22).Left) / 2
yy1 = (Cells(x + 2, y + 21).Top + Cells(x + 3, y + 23).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 21).Left + Cells(x + 2, y + 22).Left) / 2
yy2 = (Cells(x + 2, y + 21).Top + Cells(x + 3, y + 23).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 蓝球四分区()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("ab3:ae" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 27).Left + Cells(x + 2, y + 28).Left) / 2
yy1 = (Cells(x + 2, y + 27).Top + Cells(x + 3, y + 29).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 27).Left + Cells(x + 2, y + 28).Left) / 2
yy2 = (Cells(x + 2, y + 27).Top + Cells(x + 3, y + 29).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 蓝球除4余数()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("ah3:ak" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 33).Left + Cells(x + 2, y + 34).Left) / 2
yy1 = (Cells(x + 2, y + 33).Top + Cells(x + 3, y + 35).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 33).Left + Cells(x + 2, y + 34).Left) / 2
yy2 = (Cells(x + 2, y + 33).Top + Cells(x + 3, y + 35).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 蓝球小大奇偶()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("al3:ao" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 37).Left + Cells(x + 2, y + 38).Left) / 2
yy1 = (Cells(x + 2, y + 37).Top + Cells(x + 3, y + 39).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 37).Left + Cells(x + 2, y + 38).Left) / 2
yy2 = (Cells(x + 2, y + 37).Top + Cells(x + 3, y + 39).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 蓝球除3余数()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("ap3:ar" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 41).Left + Cells(x + 2, y + 42).Left) / 2
yy1 = (Cells(x + 2, y + 41).Top + Cells(x + 3, y + 43).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 41).Left + Cells(x + 2, y + 42).Left) / 2
yy2 = (Cells(x + 2, y + 41).Top + Cells(x + 3, y + 43).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 蓝球除6余数()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("as3:ax" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 44).Left + Cells(x + 2, y + 45).Left) / 2
yy1 = (Cells(x + 2, y + 44).Top + Cells(x + 3, y + 46).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 44).Left + Cells(x + 2, y + 45).Left) / 2
yy2 = (Cells(x + 2, y + 44).Top + Cells(x + 3, y + 46).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 蓝球除5余数()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("Ay3:Bc" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 50).Left + Cells(x + 2, y + 51).Left) / 2
yy1 = (Cells(x + 2, y + 50).Top + Cells(x + 3, y + 52).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 50).Left + Cells(x + 2, y + 51).Left) / 2
yy2 = (Cells(x + 2, y + 50).Top + Cells(x + 3, y + 52).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 蓝球升平降()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("bd3:bf" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 55).Left + Cells(x + 2, y + 56).Left) / 2
yy1 = (Cells(x + 2, y + 55).Top + Cells(x + 3, y + 57).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 55).Left + Cells(x + 2, y + 56).Left) / 2
yy2 = (Cells(x + 2, y + 55).Top + Cells(x + 3, y + 57).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
'Sub 蓝球遗漏分布图()
'Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
'Myr = [a1000].End(xlUp).Row
'Arr = Range("bh2:br" & Myr)
'n = 1
'For x = 1 To UBound(Arr)
'For y = 3 To UBound(Arr, 2)
' If Arr(x, y).Value >= Arr(1, y - 2).Value And Arr(x, y).Value <= Arr(2, y - 1).Value Then
' If n = 1 Then
' xx1 = (Cells(x + 2, y + 61).Left + Cells(x + 2, y + 62).Left) / 2
' yy1 = (Cells(x + 2, y + 61).Top + Cells(x + 3, y + 63).Top) / 2
' n = n + 1
' GoTo 100
' Else
' xx2 = (Cells(x + 2, y + 61).Left + Cells(x + 2, y + 62).Left) / 2
' yy2 = (Cells(x + 2, y + 61).Top + Cells(x + 3, y + 63).Top) / 2
' n = 2
' ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
' Selection.ShapeRange.Line.Weight = 1
' Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
' xx1 = xx2: yy1 = yy2
' GoTo 100
' End If
' End If
'Next y
'100:
'Next x
'End Sub
Sub 遗漏大小奇偶()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("bv3:by" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 73).Left + Cells(x + 2, y + 74).Left) / 2
yy1 = (Cells(x + 2, y + 73).Top + Cells(x + 3, y + 75).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 73).Left + Cells(x + 2, y + 74).Left) / 2
yy2 = (Cells(x + 2, y + 73).Top + Cells(x + 3, y + 75).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 遗漏除3余数()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("bz3:Cb" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 77).Left + Cells(x + 2, y + 78).Left) / 2
yy1 = (Cells(x + 2, y + 77).Top + Cells(x + 3, y + 79).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 77).Left + Cells(x + 2, y + 78).Left) / 2
yy2 = (Cells(x + 2, y + 77).Top + Cells(x + 3, y + 79).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 遗漏升平降()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("Cc3:Ce" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 80).Left + Cells(x + 2, y + 81).Left) / 2
yy1 = (Cells(x + 2, y + 80).Top + Cells(x + 3, y + 82).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 80).Left + Cells(x + 2, y + 81).Left) / 2
yy2 = (Cells(x + 2, y + 80).Top + Cells(x + 3, y + 82).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 振幅走势图()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("Cg3:Cv" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 84).Left + Cells(x + 2, y + 85).Left) / 2
yy1 = (Cells(x + 2, y + 84).Top + Cells(x + 3, y + 86).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 84).Left + Cells(x + 2, y + 85).Left) / 2
yy2 = (Cells(x + 2, y + 84).Top + Cells(x + 3, y + 86).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 振幅大小奇偶()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("da3:dd" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 104).Left + Cells(x + 2, y + 105).Left) / 2
yy1 = (Cells(x + 2, y + 104).Top + Cells(x + 3, y + 106).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 104).Left + Cells(x + 2, y + 105).Left) / 2
yy2 = (Cells(x + 2, y + 104).Top + Cells(x + 3, y + 106).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 振幅除3余数()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("de3:dg" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 108).Left + Cells(x + 2, y + 109).Left) / 2
yy1 = (Cells(x + 2, y + 108).Top + Cells(x + 3, y + 110).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 108).Left + Cells(x + 2, y + 109).Left) / 2
yy2 = (Cells(x + 2, y + 108).Top + Cells(x + 3, y + 110).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
Sub 振幅升平降()
Dim Myr&, Arr, x&, y&, xx1, yy1, xx2, yy2, n%
Myr = [a1000].End(xlUp).Row
Arr = Range("dh3:dj" & Myr)
n = 1
For x = 2 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
If Arr(x, y) = Arr(1, y) Then
If n = 1 Then
xx1 = (Cells(x + 2, y + 111).Left + Cells(x + 2, y + 112).Left) / 2
yy1 = (Cells(x + 2, y + 111).Top + Cells(x + 3, y + 113).Top) / 2
n = n + 1
GoTo 100
Else
xx2 = (Cells(x + 2, y + 111).Left + Cells(x + 2, y + 112).Left) / 2
yy2 = (Cells(x + 2, y + 111).Top + Cells(x + 3, y + 113).Top) / 2
n = 2
ActiveSheet.Shapes.AddLine(xx1, yy1, xx2, yy2).Select
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
xx1 = xx2: yy1 = yy2
GoTo 100
End If
End If
Next y
100:
Next x
End Sub
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请
点击举报。