作者：绿色风
分类：
时间：2022-08-18
浏览：216
楼主
罗刚君 |
要求:1.在工作表中任意输入数字，程序运行后根据数字的大小自动连线
2.数据按升序排列。数字不重复。
3.数字可以不连续，即4、7、8、12、100等等皆可。
具体参见图示，请用VBA编程实现
给出正确答案者 加2分技术分
难度：★★☆☆☆
 |
2楼
liuguansky |
- Sub justtest()
- ActiveSheet.DrawingObjects.Delete
- Dim Rh As Long, Cw As Long, Rng As Range, Rn As Range
- Dim k&, arrt() As Integer, i&, arr() As Long
- Rh = Cells(1).Height
- Cw = Columns(1).Width
- Set Rn = ActiveSheet.UsedRange
- For Each Rng In Rn
- If Len(Rng.Value) Then
- k = k + 1: ReDim Preserve arrt(1 To 1, 1 To k)
- arrt(1, k) = Rng.Value
- End If
- Next
- ReDim arr(1 To k, 1 To 2)
- For i = 1 To k
- Set Rng = Rn.Find(Application.Small(arrt, i), , , xlWhole)
- arr(i, 2) = (Rng.Row - 0.72) * Rh
- arr(i, 1) = (Rng.Column - 0.62) * Cw
- If i > 1 Then
- ActiveSheet.Shapes.AddConnector(msoConnectorStraight, arr(i - 1, 1), arr(i - 1, 2), arr(i, 1), arr(i, 2)).Select
- Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen
- Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadOval
- End If
- Next i
- End Sub
效果没演示的好。 |
3楼
罗刚君 |
***引用内容不可见***
换个思路 可以大大简化 |
4楼
oobird |
- Sub test()
- Set c = ActiveSheet.UsedRange
- Set a = c.Find(Application.Small(c, 1), , , 1)
- Do
- i = i + 1
- Set b = c.Find(Application.Small(c, i + 1), , , 1)
- b.Cells = "=" & a.Address & "+" & b - a
- b.ShowPrecedents
- Set a = b
- Loop Until b = Application.Max(c)
- End Sub
|
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一