九宫格动态数字连线问题

VivianDing

求助： 九宫格中动态出现数字，要求如图满足12种情况时，分别在单元格中添加连线，12种情况分别独立满足即连线，并不产生冲突，因此如果12种情况均满足，即出现交叉重叠的连线状态。

蓝桥玄霜

动态的例子：
工作表代码：
模块代码：

VivianDing

蓝桥玄霜 发表于 2023-11-23 10:19
动态的例子：
工作表代码：
模块代码：

问题已解决，感谢大神

micch

难为你了，看两遍，看懂了，

02761752696

学习一下

VivianDing

蓝桥玄霜 发表于 2023-11-23 10:19
动态的例子：
工作表代码：
模块代码：

蓝桥玄霜 发表于 2023-11-23 10:19
动态的例子：
工作表代码：
模块代码：

感谢大神

好像动态数字变化以后，再次运行程序，是一个添加线的过程，原来存在的线不会擦除。能否帮忙检查一下代码。万分感谢！

micch

VivianDing 发表于 2023-11-24 13:50
感谢大神

好像动态数字变化以后，再次运行程序，是一个添加线 ...

在增加线条后给线条起个名字，这样就能根据名字删除旧的线条

蓝桥玄霜

工作表代码不能放在模块里面，主程序也抄错一些。

VivianDing

新手小白并不会写

micch

1. Sub Main()
   
2.     With Sheet1.Range("a3:c5")
   
3.         ar = .Value
   
4.         cLine .Cells(1), .Cells(7), ar(1, 1) > 0 And ar(2, 1) > 0 And ar(3, 1) > 0
   
5.         cLine .Cells(1), .Cells(9), ar(1, 1) > 0 And ar(2, 2) > 0 And ar(3, 3) > 0
   
6.         cLine .Cells(1), .Cells(3), ar(1, 1) > 0 And ar(1, 2) > 0 And ar(1, 3) > 0
   
7.         cLine .Cells(2), .Cells(8), ar(1, 2) > 0 And ar(2, 2) > 0 And ar(3, 2) > 0
   
8.         cLine .Cells(2), .Cells(4), ar(1, 2) > 0 And ar(2, 1) > 0
   
9.         cLine .Cells(2), .Cells(6), ar(1, 2) > 0 And ar(2, 3) > 0
   
10.         cLine .Cells(3), .Cells(7), ar(1, 3) > 0 And ar(2, 2) > 0 And ar(3, 1) > 0
    
11.         cLine .Cells(3), .Cells(9), ar(1, 3) > 0 And ar(2, 3) > 0 And ar(3, 3) > 0
    
12.         cLine .Cells(4), .Cells(6), ar(2, 1) > 0 And ar(2, 2) > 0 And ar(2, 3) > 0
    
13.         cLine .Cells(4), .Cells(8), ar(2, 1) > 0 And ar(3, 2) > 0
    
14.         cLine .Cells(6), .Cells(8), ar(2, 3) > 0 And ar(3, 2) > 0
    
15.         cLine .Cells(7), .Cells(9), ar(3, 1) > 0 And ar(3, 2) > 0 And ar(3, 3) > 0
    
16.     End With
    
17. End Sub
    
18. Private Function cLine(rng1 As Range, rng2 As Range, flag0 As Boolean)
    
19.     On Error Resume Next
    
20.     Dim lNm As String
    
21.     lNm = rng1.Address(0, 0) & "_" & rng2.Address(0, 0)
    
22.     Sheet1.Shapes(lNm).Delete
    
23.     Err.Clear
    
24.     If flag0 Then
    
25.     With Sheet1.Shapes.AddLine(rng1.Left + rng1.Width / 2, rng1.Top + rng1.Height / 2, _
    
26.                                rng2.Left + rng2.Width / 2, rng2.Top + rng2.Height / 2)
    
27.             .Line.ForeColor.RGB = vbRed
    
28.             .Name = lNm
    
29.     End With
    
30.     End If
    
31. End Function

复制代码