求改下vb，excel里用的

Question

命令是excel自动划线用的，从第一行有数字的地方依次向下一行连接，现在是所有列都会连接，求改成每10列连接，每10列依次向下连接

命令发不出来，有限制，只能发图片了

Answer 1

根据具体的实际情况修改公共sub中的循环条件。

' 画一条黑色的直线
Private Sub addLine(sX As Single, sY As Single, eX As Single, eY As Single)

    ActiveSheet.Shapes.AddConnector(msoConnectorStraight, sX, sY, eX, eY).Select
    
    With Selection.ShapeRange.Line
      .Visible = msoTrue
      .ForeColor.ObjectThemeColor = msoThemeColorText1
      .ForeColor.TintAndShade = 0
      .ForeColor.Brightness = 0
      .Transparency = 0
    End With
End Sub

'使用直线连接单元格A 和 单元格B
Private Sub Line_AtoB(cellA As Variant, cellB As Variant)
  Dim wA As Single '宽
  Dim hA As Single '高
  Dim tA As Single '距离顶部
  Dim lA As Single '距离左侧
  
  wA = cellA.Width
  hA = cellA.Height
  tA = cellA.Top
  lA = cellA.Left
  

  Dim wB As Single '宽
  Dim hB As Single '高
  Dim tB As Single '距离顶部
  Dim lB As Single '距离左侧
  
  wB = cellB.Width
  hB = cellB.Height
  tB = cellB.Top
  lB = cellB.Left
  
  Dim sX As Single
  Dim sY As Single
  Dim eX As Single
  Dim eY As Single
  
  sX = wA / 2 + lA
  sY = hA / 2 + tA
  eX = wB / 2 + lB
  eY = hB / 2 + tB
  
  Call addLine(sX, sY, eX, eY)
End Sub

Public Sub 连接各个单元格()

  For i = 2 To 23
    '先找到第一个单元格
    For j = 1 To 8
      If Cells(i - 1, j).Value <> "" Then
        Set cellA = Cells(i - 1, j)
      End If
    Next
    '再找到第二个单元格
    For j = 1 To 8
      If Cells(i, j).Value <> "" Then
        Set cellB = Cells(i, j)
      End If
    Next
    
    '直线两端的单元格都找到之后划线
    Call Line_AtoB(cellA, cellB)
  Next
End Sub