|
- Private Sub CommandButton1_Click()
- Dim lr1, lc1 As Long, Arr, i&, j&, aa(), bb(), cc(), X&, Y&, z&, ys(1 To 3)
- ys(1) = 12: ys(2) = 10: ys(3) = 23
- With Sheet1
- ActiveSheet.Lines.Delete
- lr1 = .Range("a65536").End(3).Row
- lc1 = .Range("iv1").End(1).Column
- Arr = .Range(.Cells(1, 1), .Cells(lr1, lc1))
- For i = 2 To UBound(Arr)
- For j = 1 To UBound(Arr, 2)
- If .Cells(i, j).Interior.ColorIndex = 5 Then
- X = X + 1
- ReDim Preserve aa(1 To X)
- aa(X) = .Cells(i, j).Address
- ElseIf .Cells(i, j).Interior.ColorIndex = 3 Then
- Y = Y + 1
- ReDim Preserve bb(1 To Y)
- bb(Y) = .Cells(i, j).Address
- ElseIf .Cells(i, j).Interior.ColorIndex = 16 Then
- z = z + 1
- ReDim Preserve cc(1 To z)
- cc(z) = .Cells(i, j).Address
- End If
- Next
- Next
- 100:
- For i = 1 To X - 1
- myLine1 Range(aa(i)), Range(aa(i + 1)), ys(1)
- Next
- For i = 1 To Y - 1
- myLine1 Range(bb(i)), Range(bb(i + 1)), ys(2)
- Next
- For i = 1 To z - 1
- myLine1 Range(cc(i)), Range(cc(i + 1)), ys(3)
- Next
- End With
- End Sub
- Sub myLine1(Cel0 As Range, Cel1 As Range, bb)
- x0 = Cel0.Left + Cel0.Width / 2
- y0 = Cel0.Top + Cel0.Height / 2
- x1 = Cel1.Left + Cel1.Width / 2
- y1 = Cel1.Top + Cel1.Height / 2
- ActiveSheet.Shapes.AddLine(x0, y0, x1, y1).Select
- Selection.ShapeRange.Line.ForeColor.SchemeColor = bb '颜色线
- End Sub
复制代码 |
|