超多数据一次性连线

yyh023

我现有的代码只能进行B：I列的一组数据连线，
我现有的数据B：I列，j：q列,r：y列,以此类推每8列为一组数据有256组
希望大神帮忙把代买改一下一次性将所有数据连线，以下是我的代码。



Sub Alianxian1() '折线

Dim shp As Shape   ''排除图标按钮
    For Each shp In Sheet4.Shapes
        If shp.Type <> 8 And shp.Type <> 12 Then shp.Delete
    Next

Dim x1, y1, x2, y2
Dim i As Integer
Dim rng1 As Range, rng2 As Range
For i = 7 To Sheet4.Range("b5").End(xlDown).Row '表头行+2和表头行位置
    For Each rng1 In Sheet4.Range("b" & i - 1 & ":i" & i - 1) '表头行开始和结束位置
       If rng1 <> "" Then Exit For
    Next rng1
    For Each rng2 In Sheet4.Range("b" & i & ":i" & i) '表头行开始和结束位置
       If rng2 <> "" Then Exit For
    Next rng2
    x1 = rng1.Left + rng1.Width / 2
    y1 = rng1.Top + rng1.Height / 2
    x2 = rng2.Left + rng2.Width / 2
    y2 = rng2.Top + rng2.Height / 2
    Sheet4.Shapes.AddLine x1, y1, x2, y2
Next i
End Sub

gwjkkkkk

请参考。。。

yyh023

gwjkkkkk 发表于 2023-4-1 22:17
请参考。。。

非常感谢。