请问老师，怎样用excel制作彩票走势图中的数字之间的自动连线[51自学网园地]

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