Nhờ viết code cho file lập kế hoạch

[ali3340tc]

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.

 

[Hoàng Tuấn 868]

Nhờ các anh chị em hỗ trợ giúp đỡ

Nếu có ví dụ các trường hợp mong muốn sẽ dễ hình dung hơn.

 

[SA_DQ]

. . . . .
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 đỡ.

Theo mình bạn nên xoay dữ liệu trang tính để dòng thành cột & cột thành dòng; Bạn chủ bài đăng nghĩ sao?

 

[ali3340tc]

Nếu có ví dụ các trường hợp mong muốn sẽ dễ hình dung hơn.

Tôi xin ví dụ kèm comment trong file đính kèm để anh chị em dễ hình dung giúp đỡ (các dòng dưới cũng tương tự như vậy)

 

[Hoàng Tuấn 868]

Tôi xin ví dụ kèm comment trong file đính kèm để anh chị em dễ hình dung giúp đỡ (các dòng dưới cũng tương tự như vậy)

Bạn thử tham khảo thêm ý kiến bài #3 xem sao.

 

[ali3340tc]

Theo mình bạn nên xoay dữ liệu trang tính để dòng thành cột & cột thành dòng; Bạn chủ bài đăng nghĩ sao?

Cảm ơn bác đã phản hồi. Form này do công ty phát hành xuống nên không tiện thay đổi. Nhờ các bác giúp đỡ.

Cảm ơn các bác

 

[SA_DQ]

. . . . .
- 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).
. . . . . .

(1) Người thao tác sẽ tích "x" vào dòng thực hiện thì tại dòng '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)?
(2) Chuyện tích tự động này (tại dòng 'kế hoạch') sẽ phải là 1 hay bao nhiêu lần?
. . . . . . .

 

[HieuCD]

Tôi xin ví dụ kèm comment trong file đính kèm để anh chị em dễ hình dung giúp đỡ (các dòng dưới cũng tương tự như vậy)

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 Sub

 

[Phuocam]

.


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.



.

 

[ali3340tc]

(1) Người thao tác sẽ tích "x" vào dòng thực hiện thì tại dòng '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)?
(2) Chuyện tích tự động này (tại dòng 'kế hoạch') sẽ phải là 1 hay bao nhiêu lần?
. . . . . . .

(1) cái này hơi ngược tí bác ạ. Thường thì người ta lập kế hoạch rồi mới thực hiện để kiểm soát như thế nào. Tuy nhiên ở đây sẽ đưa thực hiện vào trước. sau đó ra các kế hoạch tiếp theo để người thực hiện căn cứ vào đó mà làm.
(2) về việc tích tự động: Trên form là toàn bộ ngày tháng trong cả năm. Vì vậy cần điền toàn bộ đến hết năm. Trong trường hợp tại dòng thực hiện có thay đổi khác đi (tích x không đúng chu kỳ) thì kế hoạch ngay sau đó sẽ thay đổi theo đến hết năm.

Cảm ơn các bác

 

[ali3340tc]

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 Sub

Cảm ơn bác. Tôi đã thử thành công. Nếu cần thêm gì, nhờ bác giúp đỡ tiếp nhé.

 

[bebo021999]

Cái comment này cho Na/2:

2 lần/ năm vào cuối thu và đầu xuân, mỗi lần cách nhau 3 tháng

Hơi kỳ kỳ. Có lẽ 6 tháng thì đúng hơn?

 

[ali3340tc]

Cái comment này cho Na/2:

Hơi kỳ kỳ. Có lẽ 6 tháng thì đúng hơn?

Chuẩn bác ạ. Có lẽ gõ lộn.

 

[cantl]

Hic, bài này chắc dùng hàm được mà nghĩ mãi không ra.

 

[Phuocam]

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 ...

.

 

[bebo021999]

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

 

[ali3340tc]

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

Tôi vừa thử file của bác. Chạy ok theo đúng ý đồ nhưng có một vấn đề nhỏ: Nếu như tôi xoá các chữ x ở những cột cuối, file sẽ báo thiếu số ngày tại cột G. Sau khi ok thì sẽ nhảy ra debug. Nhờ bác xem và hỗ trợ giúp. Cảm ơn bác.

 

[huuthang_bd]

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ị.