使用vba实现excel单元格自动连线

效果图

VBA代码

'清除连接线
Sub DeleteLines()

    Dim shp As Shape

    For Each shp In ActiveSheet.Shapes

        If shp.Connector = msoTrue Then

            shp.Delete

        End If

    Next shp
    
    
    Dim i As Integer
    Dim r1 As Range
    For i = 3 To Sheet2.Range("a1").End(xlDown).Row
        For Each r1 In Sheet2.Range("a" & i & ":p" & i)
            If r1 <> "" Then Exit For
        Next r1
        r1.Interior.ColorIndex = xlNone
    Next i

End Sub

'单元格连接线
Sub ConnectValues()
    Dim x1, y1, x2, y2
    Dim i As Integer
    Dim r1 As Range, r2 As Range
    For i = 3 To Sheet2.Range("a1").End(xlDown).Row
        For Each r1 In Sheet2.Range("b" & i - 1 & ":q" & i - 1)
            If r1 <> "" Then Exit For
        Next r1
        For Each r2 In Sheet2.Range("b" & i & ":q" & i)
            If r2 <> "" Then Exit For
        Next r2
        r1.Interior.ColorIndex = 8
        r2.Interior.ColorIndex = 8
        x1 = r1.Left + r1.Width / 2
        y1 = r1.Top + r1.Height / 2
        x2 = r2.Left + r2.Width / 2
        y2 = r2.Top + r2.Height / 2
        Sheet2.Shapes.AddLine x1, y1, x2, y2
    Next i
End Sub