Nhờ viết code cho file lập kế hoạch
Xin chào các anh chị em
Tôi cần viết 1 đoạn code cho file excel về kế hoạch chăm sóc cây (như đính kèm). Nhờ các anh chị em hỗ trợ giúp đỡ.
Tôi các thông tin cần như sau:
– Tại mỗi nội dung công việc (cột C) sẽ có 2 dòng liên quan: Kế hoạch và thực hiện. Người thao tác sẽ tích "x" vào dòng thực hiện thì kế hoạch sẽ tự tích x theo đúng tần suất (tần suất theo ngày tại cột G).
– Trong trường hợp kế hoạch rơi vào chủ nhật thì tự động chuyển sang ngày thứ 2 kế tiếp.Nhờ các anh chị em hỗ trợ giúp.
Cảm ơn anh chị em nhiều.
Chạy code . . .
Option Explicit
Option Compare Text
Sub ABC()
Dim arr(), aThu(), res(), sRow&, sCol&, i&, k&, j&, c&, cycle&
Application.ScreenUpdating = False
With Sheets("Khu A")
sCol = .Range("H9").End(xlToRight).Column - 1
arr = .Range("A1", .Range("A1000000").End(xlUp)).Resize(, sCol + 1).Value
sRow = UBound(arr)
End With
For i = 12 To sRow
If arr(i, 1) Like "K? ho?ch" Then
cycle = arr(i, 7)
ReDim res(1 To 1, 8 To sCol)
For j = 8 To sCol
If arr(i + 1, j) = "x" Then
LamMoi:
k = 0
For c = j + 1 To sCol
If arr(i + 1, c) = "x" Then
j = c
GoTo LamMoi
End If
k = k + 1
If k = cycle Then
If arr(9, c) = "CN" Then c = c + 1
res(1, c) = "x"
k = 0
End If
Next c
End If
Next j
Sheets("Khu A").Range("H" & i).Resize(, sCol - 7) = res
End If
Next i
Application.ScreenUpdating = True
End Subwww.giaiphapexcel.com/diendan/threads/nh%E1%BB%9D-vi%E1%BA%BFt-code-cho-file-l%E1%BA%ADp-k%E1%BA%BF-ho%E1%BA%A1ch.163671/
Khoá học Trưởng phòng nhân sự
Nguồn nhân lực là một trong Tứ trụ kinh doanh của doanh nghiệp, có tác động tới sự tồn tại và phát triển bền...
Xem khóa học
.
Nếu dữ liệu chuẩn, tức là ngày thực hiện luôn nhỏ hơn hoặc bằng ngày hôm nay, code sẽ ngắn gọn hơn.
.
Cái comment này cho Na/2:
Hơi kỳ kỳ. Có lẽ 6 tháng thì đúng hơn?
Bỏ qua 3 cột D,E,F , chỉ cần quan tâm đến cột G.
(Tác giả quên điền ngày trong G75, G77)
Code này có thể dùng để tính ngày bảo hành, bảo trì thiết bị, máy móc tiếp theo …
.
Code này tự động chạy khi gõ "x" vào các dòng Thực hiện, và dòng Kế hoạch tự động cập nhật mà không cần chạy Sub
Nguyên tắc
1- Chỉ cho nhập x vào ngày mới nhất. VD: Ngày 27/1 đã có "x" rồi thì không cho phép nhập "x" vào các ngày trước đó, ví dụ ngày 20/1
Muốn sửa ngày 20/1 là "x" thì phải xóa "x" của các ngày sau đó, là ngày 27/1
2- Cột G luôn có data số ngày. Hiện tại G75 và G77 bị thiếu
Code đặt trong worksheet module
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr&, lc&, i&, j&, ts&, ngay, kehoach, TH
Dim u As Range, day As Date
lr = Range("A11:A10000").Find(what:=Range("A13").Value, searchdirection:=xlPrevious).Row
lc = Cells(8, Columns.Count).End(xlToLeft).Column
For i = 12 To lr
If Cells(i, 1).Value = Range("A13").Value Then
If u Is Nothing Then
Set u = Range(Cells(i, 8), Cells(i, lc))
Else
Set u = Union(u, Range(Cells(i, 8), Cells(i, lc)))
End If
End If
Next
If Intersect(Target, u) Is Nothing Then Exit Sub
If Target.End(xlToRight).Column <= lc And Not IsEmpty(Target) Then
MsgBox "Da co phat sinh thuc hien sau ngay nay!"
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True
Exit Sub
End If
ngay = Range(Cells(8, Target.Column), Cells(8, lc)).Value
Range(Target.Offset(-1, 0), Cells(Target.Row – 1, lc)).ClearContents
kehoach = Range(Target.Offset(-1, 0), Cells(Target.Row – 1, lc)).Value
ts = Cells(Target.Row – 1, "G").Value
If ts = 0 Then
MsgBox "Thieu so ngay tai cot G"
Exit Sub
End If
For i = 1 To UBound(ngay, 2) – 1
day = WorksheetFunction.WorkDay_Intl(ngay(1, i) + ts – 1, 1, 11)
For j = i + 1 To UBound(ngay, 2)
If ngay(1, j) = day Then
kehoach(1, j – 1) = "x"
Exit For
End If
Next
i = i + day – ngay(1, i) – 1
Next
Target.Offset(-1, 1).Resize(1, UBound(kehoach, 2)).Value = kehoach
End Sub
Với mục đích như thớt thì không cần phải 2 dòng kế hoạch và thực hiện. Chỉ cần 1 dòng, thực hiện thì nhập x vào, kế hoạch dùng Conditional Formatting để hiển thị.