关于数字之间带连线，如何实现？

最初的梦想168

micch 发表于 2024-9-5 21:41

我最终选择你的代码，和效果图一样的 ，但是我有几处地方有疑问，我一张表格上有“数据一”，“”数据二“，“”数据三”。。。“数据七”，共7段数据需要连线  如图所示。
-------------------------------------------------------------------------------------------------------------
注意：所有需要连线的数据都是从第6行到第204行止住，第205行就不需要连线了。统计范围就是o6到DJ204，看有用一组vba代码能实现不？还是我要分7次用您的代码去实现该功能？ 当然只要用1次vba代码能实现是最好的选择，比较省心呀！     vba代码上面有很多 I j，我不理解意思，所以我也不敢乱修改，怕搞错了。              所以再次请教您，谢谢！

---------------------------------------------------------------------------------------------------------------
Sub Main()
    ReDim ar(2 To 17, 1 To 10)  (说明：2 To 17是第2行到第17行，，1to 10是第1个到第10个数字。)
    With Sheet1   （表格名称）
        For i = 2 To 17  (说明：2 To 17是第2行到第17行，，)
            k = 0
            For j = 1 To 10    (说明：1to 10是第1个到第10个数字。)
                If .Cells(i, j).Interior.Color = 255 Then
                    k = k + 1
                    ar(i, k) = j
                End If
            Next
        Next
        For j = 1 To 10
            For i = 2 To 16   ？？？？？左边是什么意思呢2to16？？
                If ar(i, j) > 0 Then     （i  j 是什么意思？     下面有很多i j。。。。呵呵）
                    If ar(i + 1, j) > 0 Then        
                        .Shapes.AddConnector msoConnectorStraight, _
                        .Cells(i, ar(i, j)).Left + .Cells(i, ar(i, j)).Width / 2, _
                        .Cells(i, ar(i, j)).Top + .Cells(i, ar(i, j)).Height / 2, _
                        .Cells(i + 1, ar(i + 1, j)).Left + .Cells(i + 1, ar(i + 1, j)).Width / 2, _
                        .Cells(i + 1, ar(i + 1, j)).Top + .Cells(i + 1, ar(i, j)).Height / 2
                    Else
                        Exit For
                    End If
                Else
                Exit For
                End If
            Next
        Next
    End With
End Sub

micch

最初的梦想168 发表于 2024-9-6 10:56
我最终选择你的代码，和效果图一样的 ，但是我有几处地方有疑问，我一张表格上有“数据一”，“”数据二 ...

i对应行，j对应列，所以如果套用到别的单元格区域，可以自己改代码。

实际来说，这个程序改成通用的，也省事，只需要把  with sheet1 改一下范围就通用了。

micch

with sheet1.range("A:J")
这样就是10列数据，行数17记得改一下，其他代码都不用改

最初的梦想168

感谢老师的回复和代码解释，但是我发现 没有加.range("A:J")代码运行是正确的，  加上with sheet1.range("A:J")去之后就报错了，我就弄不懂了。。。。报错的内容请看图片。


这样我把我原始文件发给您，您给我加进去试试，我被这个问题把头都搞大了，很伤脑筋的问题，谢谢您！ 确实在这个论坛大家庭里能从老师那学习到很多的excel知识。

------------------还有一个小问题，我测试发现的 就是“多次运行宏”后该蓝色的箭条会变大增粗，它应该是重复生成了，保留第一次生成的箭头就可以了，帮忙一起处理下呗，祝您周末愉快！！thank you！

renkangjizhen

不就是想按顺序提取每组红色的数字吗？

最初的梦想168

renkangjizhen 发表于 2024-9-6 16:38
不就是想按顺序提取每组红色的数字吗？

没有哦，您没有看我的问题， 红色数字划连线。。。。

micch

shapes的父对象是工作表，划线那里，加个sheet1

最初的梦想168

micch 发表于 2024-9-6 17:58
shapes的父对象是工作表，划线那里，加个sheet1

晚上好老师，我按照您的方法进行修改，运行的时候一直提示：运行错误“9”，下标越界。 老师麻烦您下载14楼的附件给看一下好不？  对了，我之前测试正确的表格红色背景的数字是没有公式的，那数字是我手工录入的，但是我现在这表格的数字是带公式的， 是不是这个vba代码不支持数字是公式提取的 所以才会报那个错误？
------------------------------------------------------
还有一个小问题，我测试（纯手工录入数字不带任何公式）发现的 就是“多次运行宏”后该蓝色的箭条会变大增粗，它应该是重复生成了，保留第一次生成的箭头就可以了，帮忙一起处理下呗，  老师麻烦您下载14楼的附件给看一下好不？ 不然今晚我又得失眠了 会一直想这个问题。。。 祝您周末愉快！！thank you！

最初的梦想168

这个问题有点难哦， 我把vba代码复制到 “ChatGPT” 和“文心一言”，修改几次都没搞好，人工智能技术还不是很成熟。。。。 在线等。。。。。期待完美解决闹心的问题，谢谢大家！！