Tự động vẽ đường thẳng (3 người xem)

[vanvinhctt]

Chào các anh/chị!
Mình có vấn đề mong mọi người giúp đỡ.
1. Trong sheet "Tiến độ"
các ngày trong tuần. Nếu ngày nào có khối lượng thì vẽ đường thẳng và khi mình tăng hoặc giảm độ rộng của cột thì đường thẳng này tự động tăng giảm theo (nó nằm vừa trong ô) vì bảng tính của mình rất nhiều hàng khoản 1500 hàng và nhiều bản nữa nếu làm thủ công thì mất thời gian.
2. Các anh chị cũng cho em hỏi co cách nào tô màu một phần trong ô excel (Ví dụ: Hàng có chiều rộng 3cm mình chỉ tô 2cm )
Cảm ơn mọi người

 

[vu_tuan_manh_linh]

Chào các anh/chị!
Mình có vấn đề mong mọi người giúp đỡ.
1. Trong sheet "Tiến độ"
các ngày trong tuần. Nếu ngày nào có khối lượng thì vẽ đường thẳng và khi mình tăng hoặc giảm độ rộng của cột thì đường thẳng này tự động tăng giảm theo (nó nằm vừa trong ô) vì bảng tính của mình rất nhiều hàng khoản 1500 hàng và nhiều bản nữa nếu làm thủ công thì mất thời gian.
2. Các anh chị cũng cho em hỏi co cách nào tô màu một phần trong ô excel (Ví dụ: Hàng có chiều rộng 3cm mình chỉ tô 2cm )
Cảm ơn mọi người

Có thể áp dụng Condictional Formating, Dĩ nhiên là không thể chính xác 100%, bạn có thể dùng rất nhiều cột với độ rộng nhỏ để chia thành các khoảng đơn vị.

 

[vanvinhctt]

Cảm ơn bạn vu_tuan_manh_linh. Cách này thì mình cũng đã nghĩ đến nhưng số lượng hàng trong bảng tính của mình tương đối nhiều nếu thêm hàng vào sẽ rất nhiều. Hơn nữa làm như vậy sẽ khó cho mình khi copy paste sang file khác vì các hàng của hai bảng tính không giống nhau

 

[giola]

Chào các anh/chị!
Mình có vấn đề mong mọi người giúp đỡ.
1. Trong sheet "Tiến độ"
các ngày trong tuần. Nếu ngày nào có khối lượng thì vẽ đường thẳng và khi mình tăng hoặc giảm độ rộng của cột thì đường thẳng này tự động tăng giảm theo (nó nằm vừa trong ô) vì bảng tính của mình rất nhiều hàng khoản 1500 hàng và nhiều bản nữa nếu làm thủ công thì mất thời gian.
2. Các anh chị cũng cho em hỏi co cách nào tô màu một phần trong ô excel (Ví dụ: Hàng có chiều rộng 3cm mình chỉ tô 2cm )
Cảm ơn mọi người

Thế này người ta thường dùng phần mềm MICROSOFT PROJECT nhé: linh động và nhiều tính năng khác như xác định đường Gannt, biểu đồ nhân lực ...vv

hoặc nếu vẫn thích excel, thì tham khảo ở đây
http://chandoo.org/wp/2009/06/16/gantt-charts-project-management/
Có đầy đủ hướng dẫn và file kèm, dễ hiểu làm theo là xong

 

[jack nt]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r&, Shp As Shape, CurLine As Shape, RngDraw As Range, RngTienDo As Range, Ce As Range
    Dim xBegin!, yBegin!, xEnd!, yEnd!
    r = Target.Row
    For Each Shp In Shapes
        If Shp.Top > Target.Top And Shp.Top < Target.Top + Target.Height Then
            Set CurLine = Shp
        End If
    Next
    Set RngTienDo = Range("E" & r & ":K" & r)
    For Each Ce In RngTienDo.Cells
        If Ce > 0 Then
            If RngDraw Is Nothing Then
                Set RngDraw = Ce
            Else
                Set RngDraw = Application.Union(RngDraw, Ce)
            End If
        End If
    Next
    If Not RngDraw Is Nothing Then
        With RngDraw
            xBegin = .Left
            yBegin = .Top + .Height / 2
            xEnd = .Left + .Width
            yEnd = yBegin
        End With
        If Not CurLine Is Nothing Then 'nếu đã có thì điều chỉnh
            With CurLine
                .Left = xBegin
                .Top = yBegin
                .Width = xEnd - xBegin
            End With
        Else 'chưa có thì vẽ mới
            Shapes.AddConnector(msoConnectorStraight, xBegin, yBegin, xEnd, yEnd).Line.Weight = 1.5
        End If
    End If
End Sub

P/S: tui tạm để codes trong worksheet_change, bạn cho vào chỗ nào tùy thuộc quá trình trích xuất dữ liệu sang sheet tiến độ (xem file đính kèm).

 

[vanvinhctt]

Cảm ơn bạn jack nt nhiêu. Đầy đúng là điều mình cần nhưng mình gặp rắc rối bạn. Nếu như các ngày đều có khối lượng thì ok. Nếu như cách quảng thì những ngày sau không vẽ được. Ví dụ: ngày 2,3 có khối lượng nhưng ngày 4 không có khối lượng và ngày 5 đến 8 có khối lượng thì từ ngày 5 đến ngày 8 không vẽ được bạn. Mong nhận được sự giúp đỡ của các bạn

 

[jack nt]

Cảm ơn bạn jack nt nhiêu. Đầy đúng là điều mình cần nhưng mình gặp rắc rối bạn. Nếu như các ngày đều có khối lượng thì ok. Nếu như cách quảng thì những ngày sau không vẽ được. Ví dụ: ngày 2,3 có khối lượng nhưng ngày 4 không có khối lượng và ngày 5 đến 8 có khối lượng thì từ ngày 5 đến ngày 8 không vẽ được bạn. Mong nhận được sự giúp đỡ của các bạn

thì tui chỉ làm theo yêu cầu của bạn thôi, còn trường hợp như bạn nói thì thay vì một RngDraw mình xài luôn RngDraw() là được. nếu bạn không tự làm được tui sẽ làm cho (tui nghĩ là nó cần cho công việc hơn là nghiên cứu code, tui cũng chỉ record macro rồi sửa chút thôi)

 

[jack nt]

Nếu như cách quãng thì những ngày sau không vẽ được...

nếu có cách quãng thì phải dùng nhiều hơn 1 line rồi. ở #5 dùng có 1 line nên để tiết kiệm thì chỉ sửa line cũ. ở đây thì xóa hết rồi vẽ lại trên từng đoạn.

here you are:

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i&, j&, n&, r&, Shp As Shape, RngDraw() As Range, UbDraw&
    Dim xBegin!, yBegin!, xEnd!, yEnd!, RngTienDo As Range
    r = Target.Row
    For Each Shp In Shapes
        If Shp.Top > Target.Top And Shp.Top < Target.Top + Target.Height Then
            Shp.Delete 'xóa hết line cũ có trên dòng đang xét
        End If
    Next
    Set RngTienDo = Range("E" & r & ":K" & r)
    n = RngTienDo.Cells.Count
    UbDraw = -1
    For i = 1 To n
        If RngTienDo(i) > 0 Then
            UbDraw = UbDraw + 1
            ReDim Preserve RngDraw(UbDraw)
            Set RngDraw(UbDraw) = RngTienDo(i)
            For j = i + 1 To n
                If RngTienDo(j) > 0 Then
                    Set RngDraw(UbDraw) = Application.Union(RngDraw(UbDraw), RngTienDo(j))
                Else
                    i = j
                    Exit For 'j
                End If
            Next
            i = j
        End If
    Next
    For i = 0 To UbDraw 'vẽ mới có thể nhiều hơn 1 line
        With RngDraw(i)
            xBegin = .Left
            yBegin = .Top + .Height / 2
            xEnd = .Left + .Width
            yEnd = yBegin
        End With
        Shapes.AddConnector(msoConnectorStraight, xBegin, yBegin, xEnd, yEnd).Line.Weight = 1.5
    Next
End Sub

 

[vanvinhctt]

Cảm ơn jack_nt nhiều. Bạn đã giúp mình tiết kiệm được rất nhiều thời gian.