彩票数据点与点自动连线问题

hwwh

彩票数据连线由于函数不能解决，我不懂VBA，请高手帮忙看看怎么用VBA把有函数数据的点与点连线起来，先谢谢了，详见附件 55.rar (129.43 KB, 下载次数: 201)

2012-10-27 17:52 上传

点击文件名下载附件

dsmch

1. Dim rng1 As Range, rng2 As Range, i&
   
2. For i = 2 To Range("b65536").End(xlUp).Row - 1
   
3.     Set rng1 = Cells(i, 2).Offset(0, Cells(i, 2))
   
4.     Set rng2 = Cells(i + 1, 2).Offset(0, Cells(i + 1, 2))
   
5.     x1 = rng1.Left + rng1.Width / 2
   
6.     y1 = rng1.Top + rng1.Height / 2
   
7.     x2 = rng2.Left + rng2.Width / 2
   
8.     y2 = rng2.Top + rng2.Height / 2
   
9.     ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Select
   
10. Next
    

复制代码

附件…………

hwwh

高手啊，谢谢！
能否把按钮设置红球、蓝球连线的下面， 这样方便点，同时在新添加行数后和数据后，点按钮就可以再次连线，把第一次的连线进行重新连线？麻烦了。

dsmch

开始处增加一行代码：
Range("C:C, E:E").SpecialCells(xlCellTypeConstants, 1).Delete
alt+f8执行代码或点击工具栏上的绿三角执行宏
按钮右键点击剪切掉

1. 
   

复制代码

1. Dim rng1 As Range, rng2 As Range, i&
   
2. ActiveSheet.DrawingObjects.Delete
   
3. For i = 2 To Range("b65536").End(xlUp).Row - 1
   
4.     Set rng1 = Cells(i, 2).Offset(0, Cells(i, 2))
   
5.     Set rng2 = Cells(i + 1, 2).Offset(0, Cells(i + 1, 2))
   
6.     x1 = rng1.Left + rng1.Width / 2
   
7.     y1 = rng1.Top + rng1.Height / 2
   
8.     x2 = rng2.Left + rng2.Width / 2
   
9.     y2 = rng2.Top + rng2.Height / 2
   
10.     ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Select
    
11. Next

复制代码

WEIMING1960

dsmch 发表于 2012-10-27 19:21
开始处增加一行代码：
Range("C:C, E:E").SpecialCells(xlCellTypeConstants, 1).Delete
alt+f8执行代码或 ...

老师您好以下是您帮网友的编程
Dim rng1 As Range, rng2 As Range, i&

For i = 2 To Range("b65536").End(xlUp).Row - 1

    Set rng1 = Cells(i, 2).Offset(0, Cells(i, 2))

    Set rng2 = Cells(i + 1, 2).Offset(0, Cells(i + 1, 2))

    x1 = rng1.Left + rng1.Width / 2

    y1 = rng1.Top + rng1.Height / 2

    x2 = rng2.Left + rng2.Width / 2

    y2 = rng2.Top + rng2.Height / 2

    ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Select

   Selection.ShapeRange.Line.ForeColor.SchemeColor = 10

   Selection.ShapeRange.Line.Weight = 1
Next
我想用这个程序。对VBA不了解，这个程序的数据源为b列、而我的数据源为ea列、尝试把For i = 2 To Range("b65536").End(xlUp).Row - 1改成For i = 2 To Range("ea65536").End(xlUp).Row - 1,执行程序结果在b2列是一条竖的直线，请教如何修改。这个程序是您2012-10-27 发表的。非常感谢我的邮箱：905400857@qq.com

WEIMING1960

老师您好以下是您帮网友的编程
Dim rng1 As Range, rng2 As Range, i&

For i = 2 To Range("b65536").End(xlUp).Row - 1

    Set rng1 = Cells(i, 2).Offset(0, Cells(i, 2))

    Set rng2 = Cells(i + 1, 2).Offset(0, Cells(i + 1, 2))

    x1 = rng1.Left + rng1.Width / 2

    y1 = rng1.Top + rng1.Height / 2

    x2 = rng2.Left + rng2.Width / 2

    y2 = rng2.Top + rng2.Height / 2

    ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Select

   Selection.ShapeRange.Line.ForeColor.SchemeColor = 10

   Selection.ShapeRange.Line.Weight = 1
Next
我想用这个程序。对VBA不了解，这个程序的数据源为b列、而我的数据源为ea列、尝试把For i = 2 To Range("b65536").End(xlUp).Row - 1改成For i = 2 To Range("ea65536").End(xlUp).Row - 1,执行程序结果在b2列是一条竖的直线，请教如何修改。这个程序是您2012-10-27 发表的。非常感谢我的邮箱：905400857@qq.com

middlew

学习了不错！！！！

三次握手

学习了，不错。

yrq32888

高手们忙我；连一线吗

红红火火幸福来

也正是我要的