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

Chia sẻ bởi:hands

★★★★★

‹ Tạo công thức kết hợp tham chiếu... Nối nhiều file pdf bằng code vba ›

Quảng cáo

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

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 !

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

www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-k%E1%BA%BF-ho%E1%BA%A1ch-b%E1%BA%A3o-d%C6%B0%E1%BB%A1ng-t%E1%BB%B1-%C4%91%E1%BB%99ng-trong-excel.167088/#post-1115696