Tạo kế hoạch Bảo dưỡng tự động trong Excel

[trungkiensrv]

Mình xin chào tất cả mọi người,
Mình có 1 vấn đề liên quan đến kế hoạch bảo dưỡng thiết bị bằng Excel mà đã đau đầu làm thủ công nhiều năm nay rồi nhiều khi sai sót linh tinh và mất quá nhiều thời gian.

Giờ mới nghĩ tới là đăng lên diễn đàn để nhờ các cao thủ Excel giúp đỡ.
Mình có 1 danh sách các thiết bị có yêu cầu bảo dưỡng định kỳ với tần suất bảo dưỡng Day/Month/3Month/6Month/12Month của từng thiết bị khác nhau như file gửi kèm.
Giờ mình cần lập kế hoạch bảo dưỡng của năm tiếp theo cho tất cả các máy sản xuất này với yêu cầu là chỉ cần nhập ngày bắt đầu triển khai KHBD. Sau đó Excel sẽ tự động tính toán các ngày bảo dưỡng tiếp theo căn cứ vào tần suất bảo dưỡng như ở trên (Như trong file ảnh ở Sheet2)

Ngoài ra sẽ làm thêm 1 sheet để filter các máy có kế hoạch bảo dưỡng trong thời gian từ ngày nào tới ngày nào khi cần

Đây là file mình rất cần và rất mong nhận được sự giúp đỡ của tất cả mọi người

Xin chân thành cảm ơn !

 

[trungkiensrv]

Theo tôi thì chỉ cần 2 sheet là đủ:
Sheet "List": đăng ký danh sách và thông tin
Sheet "Filter": Nhấn nút filter xem kết quả.
Trong file bạn đang +30, 60,90,180,360 ngày... mình đề xuất định nghĩa lại là cùng ngày, nhưng sau 1,3,6,12 tháng (hàm DateAdd) thì chính xác hơn

Option Explicit
Sub FilterList()
Dim lr&, i&, j&, k&, c&, rng, res(), arr()
Dim staD As Double, endD As Double, freq As Double
staD = Range("C2").Value: endD = Range("C3").Value
If staD > endD Then
    MsgBox "Ngay ket thuc phai lon hon ngay bat dau!"
    Exit Sub
End If
With Sheets("List")
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    rng = .Range("A2:G" & lr).Value
End With
ReDim arr(1 To UBound(rng), 1 To 7)
For i = 1 To UBound(rng)
    If rng(i, 4) = "Active" Then
        Select Case rng(i, 5)
            Case "Month"
                rng(i, 7) = 1
            Case "Day"
                rng(i, 7) = 0
            Case "3Month"
                rng(i, 7) = 3
            Case "6Month"
                rng(i, 7) = 6
            Case "12Month"
                rng(i, 7) = 12
        End Select
        k = k + 1
        For j = 1 To 7
            arr(k, j) = rng(i, j)
        Next
    End If
Next
ReDim res(1 To k + 2, 1 To (endD - staD + 1))
For j = 1 To UBound(res, 2)
    res(2, j) = staD + j - 1
    res(1, j) = Format(res(2, j), "ddd")
Next
For i = 1 To k
    c = 0
    If arr(i, 6) <= endD Then
        Do
            Debug.Print freq, staD, endD
            freq = IIf(arr(i, 5) = "Day", arr(i, 6) + c, DateAdd("m", c * arr(i, 7), arr(i, 6)))
            If freq >= staD And freq <= endD Then res(i + 2, freq - staD + 1) = "x"
            c = c + 1
        Loop Until freq >= endD
    End If
Next
Range("A7:ZZ100000").ClearContents
Range("A7").Resize(k, 7).Value = arr
Range("F5:ZZ6").ClearContents
Range("F5").Resize(UBound(res), UBound(res, 2)).Value = res
End Sub

Cảm ơn bạn rất nhiều Đây chính là file mà mình đang cần
Một lần nữa xin cảm ơn bạn đã giúp đỡ

 

[trungkiensrv]

Theo tôi thì chỉ cần 2 sheet là đủ:
Sheet "List": đăng ký danh sách và thông tin
Sheet "Filter": Nhấn nút filter xem kết quả.
Trong file bạn đang +30, 60,90,180,360 ngày... mình đề xuất định nghĩa lại là cùng ngày, nhưng sau 1,3,6,12 tháng (hàm DateAdd) thì chính xác hơn

Option Explicit
Sub FilterList()
Dim lr&, i&, j&, k&, c&, rng, res(), arr()
Dim staD As Double, endD As Double, freq As Double
staD = Range("C2").Value: endD = Range("C3").Value
If staD > endD Then
    MsgBox "Ngay ket thuc phai lon hon ngay bat dau!"
    Exit Sub
End If
With Sheets("List")
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    rng = .Range("A2:G" & lr).Value
End With
ReDim arr(1 To UBound(rng), 1 To 7)
For i = 1 To UBound(rng)
    If rng(i, 4) = "Active" Then
        Select Case rng(i, 5)
            Case "Month"
                rng(i, 7) = 1
            Case "Day"
                rng(i, 7) = 0
            Case "3Month"
                rng(i, 7) = 3
            Case "6Month"
                rng(i, 7) = 6
            Case "12Month"
                rng(i, 7) = 12
        End Select
        k = k + 1
        For j = 1 To 7
            arr(k, j) = rng(i, j)
        Next
    End If
Next
ReDim res(1 To k + 2, 1 To (endD - staD + 1))
For j = 1 To UBound(res, 2)
    res(2, j) = staD + j - 1
    res(1, j) = Format(res(2, j), "ddd")
Next
For i = 1 To k
    c = 0
    If arr(i, 6) <= endD Then
        Do
            Debug.Print freq, staD, endD
            freq = IIf(arr(i, 5) = "Day", arr(i, 6) + c, DateAdd("m", c * arr(i, 7), arr(i, 6)))
            If freq >= staD And freq <= endD Then res(i + 2, freq - staD + 1) = "x"
            c = c + 1
        Loop Until freq >= endD
    End If
Next
Range("A7:ZZ100000").ClearContents
Range("A7").Resize(k, 7).Value = arr
Range("F5:ZZ6").ClearContents
Range("F5").Resize(UBound(res), UBound(res, 2)).Value = res
End Sub

Chào bạn.
Mình rất cảm ơn bạn đã giúp đỡ viết code giúp mình
Sau khi chạy thử mình thử có một số thay đổi như yêu cầu trong cột G sheet "List"
Nhờ bạn kiểm tra và modify lại code giúp mình
Mình cảm ơn rất nhiều.

 

[bebo021999]

Chào bạn.
Mình rất cảm ơn bạn đã giúp đỡ viết code giúp mình
Sau khi chạy thử mình thử có một số thay đổi như yêu cầu trong cột G sheet "List"
Nhờ bạn kiểm tra và modify lại code giúp mình
Mình cảm ơn rất nhiều.

Vẫn chưa hiểu.
Cụ thể chút: Kế hoạch bảo dưỡng nằm ở đâu? Lần kế tiếp nằm ở đâu?

 

[trungkiensrv]

Vẫn chưa hiểu.
Cụ thể chút: Kế hoạch bảo dưỡng nằm ở đâu? Lần kế tiếp nằm ở đâu?

Kế hoạch Bảo dưỡng sẽ Filter theo thời gian ở sheet Filter bạn viết lần trước đó

 

[trungkiensrv]

Kế hoạch Bảo dưỡng sẽ Filter theo thời gian ở sheet Filter bạn viết lần trước đó

Bạn ơi có thời gian xem giúp mình case này với. Thanks