对指定区域内显示的数据按从左到右、从上到下的顺序连线

WYS67 · 发表于 2019-3-15 19:41

本帖最后由 WYS67 于 2019-3-16 09:26 编辑

数字连线.zip (14.12 KB, 下载次数: 5)
请老师们编写个VBA的代码。

WYS67 · 发表于 2019-3-15 21:01

请老师们编写个VBA的代码

WYS67 · 发表于 2019-3-15 22:13

可千万不敢沉了。

chxw68 · 发表于 2019-3-16 08:17

Sub test()
Dim r%, i%, c%, j%
With Worksheets("sheet1")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 5 To r - 1
For j = 2 To 12
If .Cells(i, j) <> "" Then
Exit For
End If
Next
n1 = j
For j = 2 To 12
If .Cells(i + 1, j) <> "" Then
Exit For
End If
Next
n2 = j
.Shapes.AddConnector(msoConnectorStraight, .Cells(i, n1).Left + IIf(n1 > n2, 0, .Cells(i, n1).Width), .Cells(i, n1).Top + .Cells(i, n1).Height / 2, .Cells(i + 1, n2).Left + IIf(n1 > n2, .Cells(i + 1, n2).Width, 0), .Cells(i + 1, n2).Top + .Cells(i + 1, n2).Height / 2).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
With Selection.ShapeRange.Line
.ForeColor.RGB = RGB(0, 0, 0)
.Weight = 1.5
End With
Next
End With
End Sub
Sub test2()
With Worksheets("sheet1")
For Each shp In .Shapes
shp.Delete
Next
End With
End Sub

复制代码

chxw68 · 发表于 2019-3-16 08:17

详见附件。

WYS67 · 发表于 2019-3-16 08:48

本帖最后由 WYS67 于 2019-3-16 09:04 编辑

chxw68 发表于 2019-3-16 08:17
详见附件。

非常感谢老师帮忙！还有两点小问题：1.必须按E1:E2指定为画线范围--代码只能运行在E1:E2指定的区域范围内。比如指定E1:E2为B7:L15，则B7以上，L15以下不能有画线存在；2.每次点击清理画线按钮时，总是连两个按钮都会清除掉。怎样只清除画线，不清除两个按钮？

另外，逐行画线的提法不严谨，假如E1:E2指定画线范围为B5:E10000，中间肯定有空行；能不能忽略空行，遵循从左到右，从上到下的顺序进行画线？这样，就可以更直观地观察指定重点范围内的数据变化了---如果需要重点观察数据5~8一百行内的变化，只需令E1指定F5,E2指定I104，点击画线按钮即可。

WYS67 · 发表于 2019-3-16 09:48

此贴可千万不敢沉了。

chxw68 · 发表于 2019-3-16 11:05

修改好了。

WYS67 · 发表于 2019-3-16 12:19

chxw68 发表于 2019-3-16 11:05
修改好了。

这次完完全全实现了我想要的所有功能！谢谢老师！祝老师周末愉快！

WYS67 · 发表于 2019-3-16 12:45

本帖最后由 WYS67 于 2019-3-16 12:51 编辑

chxw68 发表于 2019-3-16 11:05
修改好了。

老师：把代码复制粘贴到其它工作表后，画出的线都是双并线，看得有点眼花缭乱，能不能改成单线？

再一个，遇到同一列上下行相同的数据时，不要斜线，像相邻数据那样，修改成上下垂直的画线，这样看起来更直观些。

		自动登录	找回密码
密码			免费注册

[求助] 对指定区域内显示的数据按从左到右、从上到下的顺序连线

评分

评分

评分