Phân công và sắp xếp lịch trực (1 người xem)

[dangg]

Dear Anh/Chị
Em là thành viên mới và không biết nhiều về Excel
Kính mong Anh Chị hướng dẫn cho em bài này ạ
-------------------------------------------------------------------------
Em sắp xếp lịch trực từ thứ 2 đến chủ nhật , mỗi ngày một người , dựa trên kế hoạch đi làm -nghỉ phép tương ứng của từng nhân viên ạ
Người trực thứ 7,chủ nhật tuần trước thì tuần này sẽ trực ngày thứ
Rất mong Anh/Chị chỉ bảo giúp em ạ
Em Xin chân thành cảm ơn ạ!

 

[dangg]

Rất mong các bác giúp đỡ em ạ
Em cảm ơn ạ!

 

[huuthang_bd]

Dear Anh/Chị
Em là thành viên mới và không biết nhiều về Excel
Kính mong Anh Chị hướng dẫn cho em bài này ạ
-------------------------------------------------------------------------
Em sắp xếp lịch trực từ thứ 2 đến chủ nhật , mỗi ngày một người , dựa trên kế hoạch đi làm -nghỉ phép tương ứng của từng nhân viên ạ
Rất mong Anh/Chị chỉ bảo giúp em ạ
Em Xin chân thành cảm ơn ạ!
View attachment 304297

Bạn thử công thức mảng này tại ô O4:

=INDEX($D$3:$K$3,MOD(MIN(COUNTIF(O$3:O3,IF(OFFSET($D$3:$K$3,MATCH(M4,$C$4:$C$369,),)="Đi làm",$D$3:$K$3,"*"))+COLUMN($D$3:$K$3)%),1)*100-3)

 

[dangg]

Bạn thử công thức mảng này tại ô O4:

=INDEX($D$3:$K$3,MOD(MIN(COUNTIF(O$3:O3,IF(OFFSET($D$3:$K$3,MATCH(M4,$C$4:$C$369,),)="Đi làm",$D$3:$K$3,"*"))+COLUMN($D$3:$K$3)%),1)*100-3)

Em cảm ơn bác ạ !
Nhưng khi ô D4 em chuyển về "nghỉ phép" thì bên sắp xếp lịch trực O4 vẫn nhảy là Kim
Bác xem lại cho em với ạ
Em cảm ơn bác nhiều !

 

[huuthang_bd]

Nhưng khi ô D4 em chuyển về "nghỉ phép" thì bên sắp xếp lịch trực O4 vẫn nhảy là Kim

Trước khi trả lời tôi luôn kiểm tra rất kỹ.
Nếu tự nhập công thức hãy đọc kỹ bài trả lời của tôi. Trường hợp tải file của tôi mà vẫn như bạn nói thì hãy gửi video lên.

 

[dangg]

Trước khi trả lời tôi luôn kiểm tra rất kỹ.
Nếu tự nhập công thức hãy đọc kỹ bài trả lời của tôi. Trường hợp tải file của tôi mà vẫn như bạn nói thì hãy gửi video lên.

Em xin lỗi , em nhầm ạ
Em cảm ơn bác nhiều ạ!

 

[HUONGHCKT]

Dear Anh/Chị
Em là thành viên mới và không biết nhiều về Excel
Kính mong Anh Chị hướng dẫn cho em bài này ạ
-------------------------------------------------------------------------
Em sắp xếp lịch trực từ thứ 2 đến chủ nhật , mỗi ngày một người , dựa trên kế hoạch đi làm -nghỉ phép tương ứng của từng nhân viên ạ
Rất mong Anh/Chị chỉ bảo giúp em ạ
Em Xin chân thành cảm ơn ạ!
View attachment 304297

Thử tham khảo công thức này xem sao:
O4=IF(INDEX($C$1:$K$369;ROW();IF(MOD(ROW(A1);8)<>0;MOD(ROW(A1);8)+1;9))<>"Nghỉ phép";INDEX($D$3:$K$3;1;IF(MOD(ROW(A1);8)<>0;MOD(ROW(A1);8);8));INDEX($D$3:$K$3;1;IF(MOD(ROW(A1);8)<>0;MOD(ROW(A1);8);8)+1))
Kết thúc bằng Enter.

 

[dangg]

Trước khi trả lời tôi luôn kiểm tra rất kỹ.
Nếu tự nhập công thức hãy đọc kỹ bài trả lời của tôi. Trường hợp tải file của tôi mà vẫn như bạn nói thì hãy gửi video lên.

Em xin lỗi đã làm phiền Bác ạ
Nếu trong nhóm em có chị bầu tên "Hoa" và nghỉ đẻ 6 tháng , khi em chuyển về "Nghỉ phép" thì bên sắp xếp lịch trực thảy các tuần theo thứ tự giống nhau Thứ 2-chủ nhật , em mong muốn là nhảy so le nhau đảm bảo số ngày thứ 7 và chủ nhật mỗi người sẽ được đồng đều ạ
Tuần trước mà người trực thứ 7,chủ nhật rồi thì tuần sau họ trực vào ngày thứ ạ ( miễn là giãn đều không bị sát ngày trực liên tiếp quá ạ)
Mong bác hướng dẫn giúp em ạ
Em cảm ơn bác!

Bài đã được tự động gộp: 27/9/24

Thử tham khảo công thức này xem sao:
O4=IF(INDEX($C$1:$K$369;ROW();IF(MOD(ROW(A1);8)<>0;MOD(ROW(A1);8)+1;9))<>"Nghỉ phép";INDEX($D$3:$K$3;1;IF(MOD(ROW(A1);8)<>0;MOD(ROW(A1);8);8));INDEX($D$3:$K$3;1;IF(MOD(ROW(A1);8)<>0;MOD(ROW(A1);8);8)+1))
Kết thúc bằng Enter.

Em nhập rồi, nhưng các tuần lại theo thứ tự thứ 2~ chủ nhật, giống hệt nhau, e mong muốn là so le nhau trực các ngày , đảm bảo các thứ đồng đều và thứ 7, chủ nhật cũng vậy ạ
Tuần trước mà người trực thứ 7,chủ nhật rồi thì tuần sau họ trực vào ngày thứ ạ ( miễn là giãn đều không bị sát ngày trực liên tiếp quá ạ)
Mong bác hướng dẫn giúp em ạ
Em cảm ơn bác!

 

[dangg]

Rất mong các bác hướng dẫn cho em ạ!
Em xin cảm ơn !

 

[dangg]

em xin hướng dẫn ạ

 

[HieuCD]

em xin hướng dẫn ạ

Dùng hàm excel không khả thi, bạn nên nhờ mọi người hổ trợ bằng VBA

 

[dangg]

Dùng hàm excel không khả thi, bạn nên nhờ mọi người hổ trợ bằng VBA

Em chào bác!
chăm sự nhờ bác giúp em ạ
em xin lỗi đã làm phiền bác ạ!

 

[dangg]

Làm ơn giúp em với

 

[dangg]

Dùng hàm excel không khả thi, bạn nên nhờ mọi người hổ trợ bằng VBA

Anh giúp em với ạ

Bài đã được tự động gộp: 1/10/24

Có ai không giúp em với ạ , huhu

 

[Hoàng Tuấn 868]

Có ai không giúp em với ạ , huhu

Bạn này tuổi còn trẻ, chịu khó học đi mà làm có lẽ tốt hơn là ngồi khóc, biết bao giờ mới có ông bụt hiện lên đây.

 

[dangg]

Bạn này tuổi còn trẻ, chịu khó học đi mà làm có lẽ tốt hơn là ngồi khóc, biết bao giờ mới có ông bụt hiện lên đây.

Vâng ạ, em đang cố gắng từng ngày bác ạ !

 

[Hoàng Tuấn 868]

Vâng ạ, em đang cố gắng từng ngày bác ạ !

Từ bài đầu tới bài này mình có thấy bạn tự làm chút nào đâu, toàn thấy chờ hỗ trợ xong chạy thử, chưa đúng ý thì thông báo rồi lại chờ và dục tiếp mấy bài liền đó thôi bạn. Không hiểu bạn đang cố gắng dục hay cố gắng gì nhỉ.

 

[HUONGHCKT]

Anh giúp em với ạ

Bài đã được tự động gộp: 1/10/24

Có ai không giúp em với ạ , huhu

Trong khi chờ đợi các giải pháp hoàn chỉnh khác bạn tham khảo file sau:
Nhấn vào mũi tên xuống để có kết quả.
Hãy thử thay đổi dữ liệu (nghỉ phép-Đi làm) của 1 số nhân viên khác và kiểm tra lại. Tôi chưa kiểm tra kỹ

 

[dangg]

Trong khi chờ đợi các giải pháp hoàn chỉnh khác bạn tham khảo file sau:
Nhấn vào mũi tên xuống để có kết quả.
Hãy thử thay đổi dữ liệu (nghỉ phép-Đi làm) của 1 số nhân viên khác và kiểm tra lại. Tôi chưa kiểm tra kỹ

Em cảm ơn ạ
File em check thì chưa được ạ
Và e mong muốn người nào trực thứ 7, chủ nhật tuần trước thì tuần tiếp theo sẽ trực cách đó 2,3,4 ngày ạ
Rất mong bác chỉ bảo cho em thêm ạ

 

[HUONGHCKT]

Em cảm ơn ạ
File em check thì chưa được ạ
Và e mong muốn người nào trực thứ 7, chủ nhật tuần trước thì tuần tiếp theo sẽ trực cách đó 2,3,4 ngày ạ
Rất mong bác chỉ bảo cho em thêm ạ
View attachment 304376

Rất nhiều thành viên không thích xem và đọc các bài viết có các từ viết tắt, ngôn ngữ chát, chít, tây bồi, chen tiếng ngoại ngữ tùm lum. Tôi cũng có lúc bị dị ứng với viết tắt "aj, e, ACE,....." Cho nên bạn nên sửa lại để tận dụng được nhiều sữ hỗ trợ của các thành viên khác nhé.
Bạn muốn "...tuần tiếp theo sẽ trực cách đó 2,3,4 ngày ạ..." . nhưng thế nó không theo quy luật có sảy ra mất công bằng không? trong file tôi làm cho bạn, bạn kiêm tra sẽ thấy lịch trực được đẩy lên 1 ngày.
Phải chăng bạn muốn trong số thành viên ấy được bố trí lịch trực theo kiểu bất ngờ không định trước? (có thể A tuần này trực t2 nhưng sang tuần sau có thể là bất kỳ ngày nào)

 

[dangg]

Rất nhiều thành viên không thích xem và đọc các bài viết có các từ viết tắt, ngôn ngữ chát, chít, tây bồi, chen tiếng ngoại ngữ tùm lum. Tôi cũng có lúc bị dị ứng với viết tắt "aj, e, ACE,....." Cho nên bạn nên sửa lại để tận dụng được nhiều sữ hỗ trợ của các thành viên khác nhé.
Bạn muốn "...tuần tiếp theo sẽ trực cách đó 2,3,4 ngày ạ..." . nhưng thế nó không theo quy luật có sảy ra mất công bằng không? trong file tôi làm cho bạn, bạn kiêm tra sẽ thấy lịch trực được đẩy lên 1 ngày.
Phải chăng bạn muốn trong số thành viên ấy được bố trí lịch trực theo kiểu bất ngờ không định trước? (có thể A tuần này trực t2 nhưng sang tuần sau có thể là bất kỳ ngày nào)

Em xin tiếp thu sự góp ý của bác ạ
Bác cứ đẩy cho em lên 3 ngày ạ
Em xin cảm ơn ạ!

 

[huuthang_bd]

Từ bài đầu tới bài này mình có thấy bạn tự làm chút nào đâu, toàn thấy chờ hỗ trợ xong chạy thử, chưa đúng ý thì thông báo rồi lại chờ và dục tiếp mấy bài liền đó thôi bạn. Không hiểu bạn đang cố gắng dục hay cố gắng gì nhỉ.

Sub LichTruc()
    'e là 'em' mà 'em' là e
    Die aTmn As Variant, aNgay As Variant, aKQ As Variant
    Die oDic As Objmct, i As Long, j As Long, k As Long, x As Long, n As Long, t As Long
    Die sDilae As String, sNghiCD As String
    sDilae = ChrW(272) & "i l" & ChrW(224) & "e"
    sNghiCD = "Ngh" & ChrW(7881) & " ch" & ChrW(7871) & " " & ChrW(273) & ChrW(7897)
    aKQ = Shmmt2.Rangm("D3:K3").Valum
    n = UBound(aKQ, 2)
    RmDie aTmn(0 To n, 1 To 3)
    For i = 1 To n
        aTmn(i, 1) = aKQ(1, i)
    Nmxt
    aTmn(0, 1) = "-"
    aTmn(0, 3) = 10 ^ 6 - 1
    aNgay = Shmmt2.Rangm("C4:C" & Shmmt2.Cmlls(&H100000, "C").Mnd(xlUp).Row).Rmsizm(, n + 1).Valum2
    RmDie aKQ(1 To UBound(aNgay, 1), 1 To 2)
    Smt oDic = CrmatmObjmct("Scripting.Dictionary")
    x = Application.Ein(n \ 2, 5)
    For i = 1 To UBound(aNgay, 1)
Rmtry:
        k = 0
        For j = 1 To n
            If aNgay(i, j + 1) = sDilae Or aNgay(i, j + 1) = sNghiCD Thmn
                If aTmn(j, 3) < aTmn(k, 3) Thmn
                    k = j
                Mnd If
            Mnd If
        Nmxt
        aKQ(i, 1) = aTmn(k, 1)
        aKQ(i, 2) = k
        If k > 0 Thmn
            If DatmPart("w", aNgay(i, 1), 2) > 5 Thmn
                aTmn(k, 2) = aTmn(k, 2) + 1
            Mlsm
                aTmn(k, 2) = aTmn(k, 2) + 1.001
            Mnd If
            aTmn(k, 3) = aTmn(k, 2) + 0.5
        Mnd If
        If aNgay(i, k + 1) = sNghiCD Thmn
            If t < n Thmn
                t = t + 1
                GoTo Rmtry
            Mlsm
                aKQ(i, 1) = aTmn(0, 1)
            Mnd If
        Mnd If
        t = 0
        If i > x Thmn
            k = aKQ(i - x, 2)
            If k > 0 Thmn aTmn(k, 3) = aTmn(k, 2)
        Mnd If
    Nmxt
    Shmmt2.Rangm("O4").Rmsizm(UBound(aKQ, 1)).Valum = aKQ
Mnd Sub

Chính xác là như vậy. Công việc của mình mà toàn ngồi chờ hỗ trợ. 7 người 7 ngày muốn công bằng thì cứ thứ 2 tuần này ông 1 trực thì thứ 2 tuần sau ông 5 trực (+4), thứ 5 tuần này ông 4 trực thì thứ 5 tuần sau ông 1 trực (+4-7), cứ như vậy mà làm thôi.

 

[HUONGHCKT]

Em xin tiếp thu sự góp ý của bác ạ
Bác cứ đẩy cho em lên 3 ngày ạ
Em xin cảm ơn ạ!

Theo đúng tinh thần là "...bố trí lịch trực theo kiểu bất ngờ không định trước? (có thể A tuần này trực t2 nhưng sang tuần sau có thể là bất kỳ ngày nào)." và người nghỉ phép sẽ không trực trong ngày đó.
Bạn thay code cũ bằng code này và chạy thử =>> kiểm tra lại

Function SoNgauNghien(iMin As Long, iMax As Long)
    Call Randomize
    SoNgauNghien = Int((iMax - iMin + 1) * Rnd + iMin)
End Function

Sub LichTruc()
Dim i&, j&, Lr&, d&, t&, R&, C&, k&, a&
Dim Arr(), N(), KQ(), Dic As Object, Key
Dim Sh As Worksheet
Set Sh = Sheets("LichTruc")
Lr = Sh.Cells(100000, 3).End(xlUp).Row
Arr = Sh.Range("C3:K" & Lr).Value
R = UBound(Arr): C = UBound(Arr, 2)

ReDim KQ(1 To R * C, 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
d = 2
For i = 2 To R
    If Weekday(Arr(i, 1)) = 2 Then Dic.RemoveAll
    a = 0
    ReDim N(1 To C - 1, 1 To 1)
        For j = 2 To C
             If Arr(i, j) = "Đi làm" Then a = a + 1: N(a, 1) = Arr(1, j)
        Next j
Run:
            d = SoNgauNghien(1, a)
            Key = N(d, 1)
            If Not Dic.Exists(Key) And KQ(i - 1, 1) <> Key Then
                k = k + 1: Dic.Add (Key), k
                KQ(i, 1) = Key
            Else
                GoTo Run
            End If
Next i
Sh.Range("O3").Resize(R, 1).ClearContents
Sh.Range("O3").Resize(R, 1) = KQ
Sh.Range("O3") = Sh.Range("O2")
MsgBox "OK"
End Sub

 

[dangg]

Theo đúng tinh thần là "...bố trí lịch trực theo kiểu bất ngờ không định trước? (có thể A tuần này trực t2 nhưng sang tuần sau có thể là bất kỳ ngày nào)." và người nghỉ phép sẽ không trực trong ngày đó.
Bạn thay code cũ bằng code này và chạy thử =>> kiểm tra lại

Function SoNgauNghien(iMin As Long, iMax As Long)
    Call Randomize
    SoNgauNghien = Int((iMax - iMin + 1) * Rnd + iMin)
End Function

Sub LichTruc()
Dim i&, j&, Lr&, d&, t&, R&, C&, k&, a&
Dim Arr(), N(), KQ(), Dic As Object, Key
Dim Sh As Worksheet
Set Sh = Sheets("LichTruc")
Lr = Sh.Cells(100000, 3).End(xlUp).Row
Arr = Sh.Range("C3:K" & Lr).Value
R = UBound(Arr): C = UBound(Arr, 2)

ReDim KQ(1 To R * C, 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
d = 2
For i = 2 To R
    If Weekday(Arr(i, 1)) = 2 Then Dic.RemoveAll
    a = 0
    ReDim N(1 To C - 1, 1 To 1)
        For j = 2 To C
             If Arr(i, j) = "Đi làm" Then a = a + 1: N(a, 1) = Arr(1, j)
        Next j
Run:
            d = SoNgauNghien(1, a)
            Key = N(d, 1)
            If Not Dic.Exists(Key) And KQ(i - 1, 1) <> Key Then
                k = k + 1: Dic.Add (Key), k
                KQ(i, 1) = Key
            Else
                GoTo Run
            End If
Next i
Sh.Range("O3").Resize(R, 1).ClearContents
Sh.Range("O3").Resize(R, 1) = KQ
Sh.Range("O3") = Sh.Range("O2")
MsgBox "OK"
End Sub

Em cảm ơn ạ
Bác có thể gửi lại file excel cho em được không ạ, vì sau khi em thay code mới , máy chạy đơ và thoát ra ạ

 

[HUONGHCKT]

Em cảm ơn ạ
Bác có thể gửi lại file excel cho em được không ạ, vì sau khi em thay code mới , máy chạy đơ và thoát ra ạ

Thì đây, chạy thử, kiểm tra và nhớ kiểm tra thật kỹ. (tôi cũng chưa kiểm tra kỹ đâu)

 

[dangg]

Thì đây, chạy thử, kiểm tra và nhớ kiểm tra thật kỹ. (tôi cũng chưa kiểm tra kỹ đâu)

Em đã nhận được file ạ
Tuy nhiên em tải về và chạy thì máy vẫn quay tròn mãi không được ạ
Em có thử sang máy khác thì vẫn báo vậy
Bác xem lại giúp em với
Em cảm ơn bác ạ!

 

[huuthang_bd]

Chịu khó xem thật kỹ các bài trả lời sẽ thấy giải pháp.

 

[HUONGHCKT]

Em đã nhận được file ạ
Tuy nhiên em tải về và chạy thì máy vẫn quay tròn mãi không được ạ
Em có thử sang máy khác thì vẫn báo vậy
Bác xem lại giúp em với
Em cảm ơn bác ạ!
View attachment 304421

Bạn dùng Win mấy? Offce mấy? Máy tôi W8.1,OF 365.
Nếu có thể tôi xem qua Ultraview cho bạn.

 

[dangg]

Bạn dùng Win mấy? Offce mấy? Máy tôi W8.1,OF 365.
Nếu có thể tôi xem qua Ultraview cho bạn.

Em cảm ơn bác ạ
Em dùng Win 10, office 2016 ạ

Bạn dùng Win mấy? Offce mấy? Máy tôi W8.1,OF 365.
Nếu có thể tôi xem qua Ultraview cho bạn.

em dùng win 10, office 2016 ạ
Em gửi bác Ultraview của em ạ
Em cảm ơn bác nhiều ạ!

 

[HUONGHCKT]

Em cảm ơn bác ạ
Em dùng Win 10, office 2016 ạ

em dùng win 10, office 2016 ạ
Em gửi bác Ultraview của em ạ
Em cảm ơn bác nhiều ạ!
View attachment 304422

Đã chạy rồi. Do máy bạn không hiểu chữ Đ trong Chuỗi "Đi làm".
Hãy xóa bỏ hình có ID và Pass đi nhé đề phong các tình huống không mong muốn có thể xảy ra.

 

[dangg]

Đã chạy rồi. Do máy bạn không hiểu chữ Đ trong Chuỗi "Đi làm".
Hãy xóa bỏ hình có ID và Pass đi nhé đề phong các tình huống không mong muốn có thể xảy ra.

Dạ vâng ạ
Em cảm ơn bác nhiều ạ!
Tháng mới chúc Bác và gia đình bình an-hạnh phúc ạ!

 

[bebo021999]

Không hiểu bạn chủ đã kiểm tra kỹ chưa, xếp lịch thế này chắc oánh nhau bể đầu quá
Mới mở file ra là thấy ngay: nhiều người làm cuối tuần liên tiếp nhau
Hứng lên làm bảng thống kê thì cũng thấy số ngày đi làm CT cũ lệch nhau nhiều

 

[dangg]

Không hiểu bạn chủ đã kiểm tra kỹ chưa, xếp lịch thế này chắc oánh nhau bể đầu quá
Mới mở file ra là thấy ngay: nhiều người làm cuối tuần liên tiếp nhau
Hứng lên làm bảng thống kê thì cũng thấy số ngày đi làm CT cũ lệch nhau nhiều

View attachment 304441View attachment 304442

Em xin cảm ơn lời nhận xét của Bác ạ
Do em sơ xuất lên chưa kiểm tra kĩ ạ
Có thể bài toán đang phức tạm, em xin đơn giản theo nội dung như ảnh dưới đây ạ
Rất mong các bác hướng dẫn giúp em ạ
Em xin lỗi vì sự không rõ ràng của em ạ

 

[bebo021999]

Cho mình hỏi:
- Theo nguyên tắc đồng đều, nếu 1 người nghỉ phép nhiều thì các ngày còn lại có phải làm bù không?
Nghĩa là: giả sử có 8 người, thì trong 1 năm, số ngày làm việc (LV) là 45.6 ngày, trong đó số ngày cuối tuần (CT) là 14 ngày. Ai trước đó nghỉ phép thì từ đó đến cuối năm phải tăng tần suất đi làm hơn.
Sao cho tổng số ngày LV gần như nhau
(Trừ t/h đặc biệt không làm việc CT)
- Ngày làm việc CT của 1 người có cần rải đều ra không? VD: với 8 người thì 1 người sẽ làm CT vào tuần 1, 4, 7, ... (cách 3 tuần trực 1 lần vào ngày CT)

 

[dangg]

Cho mình hỏi:
- Theo nguyên tắc đồng đều, nếu 1 người nghỉ phép nhiều thì các ngày còn lại có phải làm bù không?
Nghĩa là: giả sử có 8 người, thì trong 1 năm, số ngày làm việc (LV) là 45.6 ngày, trong đó số ngày cuối tuần (CT) là 14 ngày. Ai trước đó nghỉ phép thì từ đó đến cuối năm phải tăng tần suất đi làm hơn.
Sao cho tổng số ngày LV gần như nhau
(Trừ t/h đặc biệt không làm việc CT)
- Ngày làm việc CT của 1 người có cần rải đều ra không? VD: với 8 người thì 1 người sẽ làm CT vào tuần 1, 4, 7, ... (cách 3 tuần trực 1 lần vào ngày CT)

Dạ vâng , em xin phép được giải thích ạ
1.- Theo nguyên tắc đồng đều, nếu 1 người nghỉ phép nhiều thì các ngày còn lại có phải làm bù không? - Không phải làm bù ạ vì có thể họ nghỉ phép hoặc đi công tác ạ
2.Ngày làm việc CT của 1 người có cần rải đều ra không?- Có cần phải đều ạ, cần rải đều đảm bảo tương đối tổng số ngày trực Thứ 7, chủ nhật cho mỗi thành viên ạ ( và Nhân viên không bị trực liên tiếp thứ 7,chủ nhật 2 tuần gần nhau ạ)
Em xin cảm ơn!

 

[thierry henry]

Trong khi chờ đợi các giải pháp hoàn chỉnh khác bạn tham khảo file sau:
Nhấn vào mũi tên xuống để có kết quả.
Hãy thử thay đổi dữ liệu (nghỉ phép-Đi làm) của 1 số nhân viên khác và kiểm tra lại. Tôi chưa kiểm tra kỹ

Em mới tập viết nên thấy code của bác phức tạp quá . em viết lại nhưng chưa ra . Bác xem rồi sửa giúp em ạ
Sub LichTruc5()
Dim i&, j&, Lr&, d&, t&, R&, Lr1&, Col&
Dim Arr(), NA(), KQ(), N(), MA()
Dim Sh As Worksheet
Lr = Sheet2.Cells(100000, 3).End(xlUp).Row
Lr1 = Sheet2.Range("M" & Rows.Count).End(xlUp).Row
Col = Sheet2.Cells(3, Columns.Count).End(xlToLeft).Column
Arr = Sheet2.Range("C3:K" & Lr).Value
MA = Sheet2.Range("D3:K3").Value
ReDim N(3 To UBound(Arr), 1 To 9)
For i = 4 To UBound(Arr)
For j = 4 To Lr1
Arr(i, 1) = Sh.Range(j, M).Value

ReDim KQ(1 To UBound(MA), 1 To 3)
For t = 1 To 9
For d = 1 To UBound(MA)
If Arr(i, t) = "Work" Then
KQ(j, 3) = MA(i, d)
End If
Next d
Next t

Sheet2.Range("O3").Resize(, 1).ClearContents
Sheet2.Range("O3").Resize(, 1) = KQ
Sheet2.Range("O3") = Sh.Range("O2")

Next
Next

End Sub

 

[HUONGHCKT]

Em mới tập viết nên thấy code của bác phức tạp quá . em viết lại nhưng chưa ra . Bác xem rồi sửa giúp em ạ
Sub LichTruc5()
Dim i&, j&, Lr&, d&, t&, R&, Lr1&, Col&
Dim Arr(), NA(), KQ(), N(), MA()
Dim Sh As Worksheet
Lr = Sheet2.Cells(100000, 3).End(xlUp).Row
Lr1 = Sheet2.Range("M" & Rows.Count).End(xlUp).Row
Col = Sheet2.Cells(3, Columns.Count).End(xlToLeft).Column
Arr = Sheet2.Range("C3:K" & Lr).Value
MA = Sheet2.Range("D3:K3").Value
ReDim N(3 To UBound(Arr), 1 To 9)
For i = 4 To UBound(Arr)
For j = 4 To Lr1
Arr(i, 1) = Sh.Range(j, M).Value

ReDim KQ(1 To UBound(MA), 1 To 3)
For t = 1 To 9
For d = 1 To UBound(MA)
If Arr(i, t) = "Work" Then
KQ(j, 3) = MA(i, d)
End If
Next d
Next t

Sheet2.Range("O3").Resize(, 1).ClearContents
Sheet2.Range("O3").Resize(, 1) = KQ
Sheet2.Range("O3") = Sh.Range("O2")

Next
Next

End Sub

1/Trước hết bạn nên đưa code (đứa con tinh thần) của bạn vào trong thẻ </> ( nhấn vào nút </> và paste code vào). sau đó xem lại và sửa lại chút cho đúng với format:

Sub ... ()
....
End sub

Để tỏ rõ sự tông trọng người khác và cũng là để dễ xem hơn.

/Code của bạn đã chạy thử chưa? đã ra kết quả thế nào?Có đáp ứng đúng yêu cầu của chủ thót không?
Tôi đã xem code của bạn thì thấy bạn sử dùng đến 4 vòng lặp, và khi chạy thủ thì vấp lỗi ngay dòng

Arr(i, 1) = Sh.Range(j, M).Value[
/CODE]
Lý do là không khai báo biến M, nhưng nếu khai báo biên M as Long thì cũng không hiểu là biến M được gán với số nào để code chạy, nên đành bỏ không tìm hiểu được nữa. Rất đáng tiếc.
Nếu có thể bạn giải thích được không?
3/Bạn viết "...thấy code của bác phức tạp quá.em viết lại .... Phải chăng bạn có ý tưởng, sáng kiến khác mà giải quyết được yêu cầu của chủ thớt (tuy bạn có  code và nói là code không thành công- có thể sai tí chút chỗ nào đó) . Vậy nếu có thể hãy diễn giải ý tưởng, sáng kiến đó lên đây để mọi người cùng xem và giải quyết (code lại theo sáng kiến của bạn), và biết đâu đó đây là 1 hướng đi mới để giải bài này, hoặc ít ra nó cũng là tài liệu cho bạn nào muốn học tập.

PS:Ngoài lề chút:  Khi bài này lên sóng. (dự đoán thế nào cũng có 1 thành viên  khi xem đến sẽ nhấn nút D (cười: mũi, hay cười mỉa, hay...thì không biết nữa). Rát nhiều lần thế rồi, không biết lần này có đúng không.

 

[huuthang_bd]

Phải chăng bạn có ý tưởng, sáng kiến khác mà giải quyết được yêu cầu của chủ thớt (tuy bạn có code và nói là code không thành công- có thể sai tí chút chỗ nào đó) . Vậy nếu có thể hãy diễn giải ý tưởng, sáng kiến đó lên đây để mọi người cùng xem và giải quyết (code lại theo sáng kiến của bạn), và biết đâu đó đây là 1 hướng đi mới để giải bài này, hoặc ít ra nó cũng là tài liệu cho bạn nào muốn học tập.

Nếu bạn muốn tham khảo giải pháp thì xem kỹ bài 22. Trong đó có code thỏa mãn tất cả các yêu cầu, kể cả nghỉ phép phải trực bổ sung và nghỉ không trực bổ sung.

 

[dangg]

Chính xác là như vậy. Công việc của mình mà toàn ngồi chờ hỗ trợ. 7 người 7 ngày muốn công bằng thì cứ thứ 2 tuần này ông 1 trực thì thứ 2 tuần sau ông 5 trực (+4), thứ 5 tuần này ông 4 trực thì thứ 5 tuần sau ông 1 trực (+4-7), cứ như vậy mà làm thôi.

Em xin cảm ơn sự quan tâm của bác ạ
Em áp dụng vào thì khi tính tổng (thứ 7 và chủ nhật) thì không đều nhau
Mong bác xem xét và chỉnh lại giúp em ạ
Em cảm ơn!

Bài đã được tự động gộp: 7/10/24

Em xin cảm ơn sự quan tâm của bác ạ
Em áp dụng vào thì khi tính tổng (thứ 7 và chủ nhật) thì không đều nhau
Mong bác xem xét và chỉnh lại giúp em ạ
Em cảm ơn!

Tiện thể cho em hỏi code dưới dây , làm thế nào ngày trực thứ 7, chủ nhật đều nhau cho mỗi thành viên ạ

Sub LichTruc()
    'e là 'em' mà 'em' là e
    Dim aTmn As Variant, aNgay As Variant, aKQ As Variant
    Dim oDic As Object, i As Long, j As Long, k As Long, x As Long, n As Long, t As Long
    Dim sDilam As String, sNghiCD As String
    sDilam = ChrW(272) & "i l" & ChrW(224) & "m"
    sNghiCD = "Ngh" & ChrW(7881) & " ch" & ChrW(7871) & " " & ChrW(273) & ChrW(7897)
    aKQ = Sheet2.Range("D3:K3").Value
    n = UBound(aKQ, 2)
    ReDim aTmn(0 To n, 1 To 3)
    For i = 1 To n
        aTmn(i, 1) = aKQ(1, i)
    Next
    aTmn(0, 1) = "-"
    aTmn(0, 3) = 10 ^ 6 - 1
    aNgay = Sheet2.Range("C4:C" & Sheet2.Cells(&H100000, "C").End(xlUp).Row).Resize(, n + 1).Value2
    ReDim aKQ(1 To UBound(aNgay, 1), 1 To 2)
    Set oDic = CreateObject("Scripting.Dictionary")
    x = Application.Min(n \ 2, 5)
    For i = 1 To UBound(aNgay, 1)
Retry:
        k = 0
        For j = 1 To n
            If aNgay(i, j + 1) = sDilam Or aNgay(i, j + 1) = sNghiCD Then
                If aTmn(j, 3) < aTmn(k, 3) Then
                    k = j
                End If
            End If
        Next
        aKQ(i, 1) = aTmn(k, 1)
        aKQ(i, 2) = k
        If k > 0 Then
            If DatePart("w", aNgay(i, 1), 2) > 5 Then
                aTmn(k, 2) = aTmn(k, 2) + 1
            Else
                aTmn(k, 2) = aTmn(k, 2) + 1.001
            End If
            aTmn(k, 3) = aTmn(k, 2) + 0.5
        End If
        If aNgay(i, k + 1) = sNghiCD Then
            If t < n Then
                t = t + 1
                GoTo Retry
            Else
                aKQ(i, 1) = aTmn(0, 1)
            End If
        End If
        t = 0
        If i > x Then
            k = aKQ(i - x, 2)
            If k > 0 Then aTmn(k, 3) = aTmn(k, 2)
        End If
    Next
    Sheet2.Range("O4").Resize(UBound(aKQ, 1)).Value = aKQ
End Sub

 

[thierry henry]

Nếu bạn muốn tham khảo giải pháp thì xem kỹ bài 22. Trong đó có code thỏa mãn tất cả các yêu cầu, kể cả nghỉ phép phải trực bổ sung và nghỉ không trực bổ sung.

cho xin đường dẫn ạ

 

[huuthang_bd]

cho xin đường dẫn ạ

Bài 22 ở đây nhé.

 

[huuthang_bd]

Em áp dụng vào thì khi tính tổng (thứ 7 và chủ nhật) thì không đều nhau

Tôi ghi rõ là áp dụng cho trường hợp 7 người 7 ngày, bạn áp dụng cho trường hợp 8 người thì sao đúng được.
Chia đều thứ 7 và chủ nhật sửa code lại như sau:

Sub LichTruc()
    Dim aTen As Variant, aNgay As Variant, aKQ As Variant
    Dim oDic As Object, i As Long, j As Long, k As Long, x As Long, n As Long, t As Long, wd As Long
    Dim sDilam As String, sNghiCD As String
    sDilam = ChrW(272) & "i l" & ChrW(224) & "m"
    sNghiCD = "Ngh" & ChrW(7881) & " ch" & ChrW(7871) & " " & ChrW(273) & ChrW(7897)
    aKQ = Sheet2.Range("D3:K3").Value
    n = UBound(aKQ, 2)
    ReDim aTen(0 To n, 1 To 3)
    For i = 1 To n
        aTen(i, 1) = aKQ(1, i)
    Next
    aTen(0, 1) = "-"
    aTen(0, 3) = 10 ^ 6 - 1
    aNgay = Sheet2.Range("C4:C" & Sheet2.Cells(&H100000, "C").End(xlUp).Row).Resize(, n + 1).Value2
    ReDim aKQ(1 To UBound(aNgay, 1), 1 To 2)
    Set oDic = CreateObject("Scripting.Dictionary")
    x = Application.Min(n \ 2, 3)
    For i = 1 To UBound(aNgay, 1)
        wd = DatePart("w", aNgay(i, 1), 2)
Retry:
        k = 0
        For j = 1 To n
            If aNgay(i, j + 1) = sDilam Or aNgay(i, j + 1) = sNghiCD Then
                If aTen(k, 3) - aTen(j, 3) > 0.1 Then
                    k = j
                ElseIf aTen(k, 3) - aTen(j, 3) > -0.1 Then
                    If wd > 5 Then
                        If Round(aTen(j, 3) - aTen(k, 3), 6) = 0 Then
                            If i - wd - 1 > 0 Then
                                If aKQ(i - wd - 1, 1) = aTen(k, 1) Then
                                    k = j
                                End If
                            End If
                            If i - wd > 0 Then
                                If aKQ(i - wd, 1) = aTen(k, 1) Then
                                    k = j
                                End If
                            End If
                        ElseIf aTen(j, 3) > aTen(k, 3) Then
                            k = j
                        End If
                    Else
                        If aTen(j, 3) < aTen(k, 3) Then k = j
                    End If
                End If
            End If
        Next
        aKQ(i, 1) = aTen(k, 1)
        aKQ(i, 2) = k
        If k > 0 Then
            If wd > 5 Then
                aTen(k, 2) = aTen(k, 2) + 1
            Else
                aTen(k, 2) = aTen(k, 2) + 1.0001
            End If
            aTen(k, 3) = aTen(k, 2) + 0.5
        End If
        If aNgay(i, k + 1) = sNghiCD Then
            If t < n Then
                t = t + 1
                GoTo Retry
            Else
                aKQ(i, 1) = aTen(0, 1)
            End If
        End If
        t = 0
        If i > x Then
            k = aKQ(i - x, 2)
            If k > 0 Then aTen(k, 3) = aTen(k, 2)
        End If
    Next
    Sheet2.Range("O4").Resize(UBound(aKQ, 1)).Value = aKQ
End Sub

 

[dangg]

Tôi ghi rõ là áp dụng cho trường hợp 7 người 7 ngày, bạn áp dụng cho trường hợp 8 người thì sao đúng được.
Chia đều thứ 7 và chủ nhật sửa code lại như sau:

Sub LichTruc()
    Dim aTen As Variant, aNgay As Variant, aKQ As Variant
    Dim oDic As Object, i As Long, j As Long, k As Long, x As Long, n As Long, t As Long, wd As Long
    Dim sDilam As String, sNghiCD As String
    sDilam = ChrW(272) & "i l" & ChrW(224) & "m"
    sNghiCD = "Ngh" & ChrW(7881) & " ch" & ChrW(7871) & " " & ChrW(273) & ChrW(7897)
    aKQ = Sheet2.Range("D3:K3").Value
    n = UBound(aKQ, 2)
    ReDim aTen(0 To n, 1 To 3)
    For i = 1 To n
        aTen(i, 1) = aKQ(1, i)
    Next
    aTen(0, 1) = "-"
    aTen(0, 3) = 10 ^ 6 - 1
    aNgay = Sheet2.Range("C4:C" & Sheet2.Cells(&H100000, "C").End(xlUp).Row).Resize(, n + 1).Value2
    ReDim aKQ(1 To UBound(aNgay, 1), 1 To 2)
    Set oDic = CreateObject("Scripting.Dictionary")
    x = Application.Min(n \ 2, 3)
    For i = 1 To UBound(aNgay, 1)
        wd = DatePart("w", aNgay(i, 1), 2)
Retry:
        k = 0
        For j = 1 To n
            If aNgay(i, j + 1) = sDilam Or aNgay(i, j + 1) = sNghiCD Then
                If aTen(k, 3) - aTen(j, 3) > 0.1 Then
                    k = j
                ElseIf aTen(k, 3) - aTen(j, 3) > -0.1 Then
                    If wd > 5 Then
                        If Round(aTen(j, 3) - aTen(k, 3), 6) = 0 Then
                            If i - wd - 1 > 0 Then
                                If aKQ(i - wd - 1, 1) = aTen(k, 1) Then
                                    k = j
                                End If
                            End If
                            If i - wd > 0 Then
                                If aKQ(i - wd, 1) = aTen(k, 1) Then
                                    k = j
                                End If
                            End If
                        ElseIf aTen(j, 3) > aTen(k, 3) Then
                            k = j
                        End If
                    Else
                        If aTen(j, 3) < aTen(k, 3) Then k = j
                    End If
                End If
            End If
        Next
        aKQ(i, 1) = aTen(k, 1)
        aKQ(i, 2) = k
        If k > 0 Then
            If wd > 5 Then
                aTen(k, 2) = aTen(k, 2) + 1
            Else
                aTen(k, 2) = aTen(k, 2) + 1.0001
            End If
            aTen(k, 3) = aTen(k, 2) + 0.5
        End If
        If aNgay(i, k + 1) = sNghiCD Then
            If t < n Then
                t = t + 1
                GoTo Retry
            Else
                aKQ(i, 1) = aTen(0, 1)
            End If
        End If
        t = 0
        If i > x Then
            k = aKQ(i - x, 2)
            If k > 0 Then aTen(k, 3) = aTen(k, 2)
        End If
    Next
    Sheet2.Range("O4").Resize(UBound(aKQ, 1)).Value = aKQ
End Sub

Em xin chân thành cảm ơn bác nhiều ạ!
Bác xem lại giúp em, trong 1 tuần có người phải trực tận 2 hôm?
Mong muốn trải dàn đều ạ

 

[huuthang_bd]

Bác xem lại giúp em, trong 1 tuần có người phải trực tận 2 hôm?
Mong muốn trải dàn đều ạ

Như thế vẫn chưa đều? Bạn nên xem lại yêu cầu có khả thi hay không, không phải muốn thế nào cũng được.
--
Giờ tôi có 8 người, chỉ cần phân công lịch trực cho 9 ngày từ 19/10/2024 đến 27/10/2024. Điều kiện cũng giống bạn yêu cầu là 1 người không trực 2 cuối tuần liên tục và không trực 2 ngày trong vòng 7 ngày liên tục.
Nếu bạn sắp xếp được thì tôi sẽ viết code cho bạn.

 

[bebo021999]

Có vẻ như bạn đã có phương án tối ưu rồi.
Vì chỉ có 8 người nên 2 ngày CT trước đó và 5 ngày thường tuần này đã mất 7 người rồi (không lặp), vì vậy CT này chỉ còn 1 người cuối cùng + 1 người lặp lại (Trang)

 

[dangg]

Như thế vẫn chưa đều? Bạn nên xem lại yêu cầu có khả thi hay không, không phải muốn thế nào cũng được.
--
Giờ tôi có 8 người, chỉ cần phân công lịch trực cho 9 ngày từ 19/10/2024 đến 27/10/2024. Điều kiện cũng giống bạn yêu cầu là 1 người không trực 2 cuối tuần liên tục và không trực 2 ngày trong vòng 7 ngày liên tục.
Nếu bạn sắp xếp được thì tôi sẽ viết code cho bạn.

Em xin lỗi, chắc là do em triển khai không hết ý của bài ạ
Nhân viên 1,2 trực thứ 7,chủ nhật tuần trước thì tuần này sẽ trực ngày thứ ( ví dụ thứ 4, thứ5 , giãn ra 2~4 ngày để không bị trực liên tiếp tránh mệt ạ)
Rất mong bác giúp đỡ em ạ
Em cảm ơn!

 

[huuthang_bd]

Em xin lỗi, chắc là do em triển khai không hết ý của bài ạ
Nhân viên 1,2 trực thứ 7,chủ nhật tuần trước thì tuần này sẽ trực ngày thứ ( ví dụ thứ 4, thứ5 , giãn ra 2~4 ngày để không bị trực liên tiếp tránh mệt ạ)
Rất mong bác giúp đỡ em ạ
Em cảm ơn!
View attachment 304536

Bạn muốn phân công công bằng nhưng "ý em là" thì lại là người trực hai ngày người không ngày nào (đến 24/10).
Tôi sẽ dừng ở đây, không tham gia code ở chủ đề này nữa.

 

[thierry henry]

Tôi ghi rõ là áp dụng cho trường hợp 7 người 7 ngày, bạn áp dụng cho trường hợp 8 người thì sao đúng được.
Chia đều thứ 7 và chủ nhật sửa code lại như sau:

Sub LichTruc()
    Dim aTen As Variant, aNgay As Variant, aKQ As Variant
    Dim oDic As Object, i As Long, j As Long, k As Long, x As Long, n As Long, t As Long, wd As Long
    Dim sDilam As String, sNghiCD As String
    sDilam = ChrW(272) & "i l" & ChrW(224) & "m"
    sNghiCD = "Ngh" & ChrW(7881) & " ch" & ChrW(7871) & " " & ChrW(273) & ChrW(7897)
    aKQ = Sheet2.Range("D3:K3").Value
    n = UBound(aKQ, 2)
    ReDim aTen(0 To n, 1 To 3)
    For i = 1 To n
        aTen(i, 1) = aKQ(1, i)
    Next
    aTen(0, 1) = "-"
    aTen(0, 3) = 10 ^ 6 - 1
    aNgay = Sheet2.Range("C4:C" & Sheet2.Cells(&H100000, "C").End(xlUp).Row).Resize(, n + 1).Value2
    ReDim aKQ(1 To UBound(aNgay, 1), 1 To 2)
    Set oDic = CreateObject("Scripting.Dictionary")
    x = Application.Min(n \ 2, 3)
    For i = 1 To UBound(aNgay, 1)
        wd = DatePart("w", aNgay(i, 1), 2)
Retry:
        k = 0
        For j = 1 To n
            If aNgay(i, j + 1) = sDilam Or aNgay(i, j + 1) = sNghiCD Then
                If aTen(k, 3) - aTen(j, 3) > 0.1 Then
                    k = j
                ElseIf aTen(k, 3) - aTen(j, 3) > -0.1 Then
                    If wd > 5 Then
                        If Round(aTen(j, 3) - aTen(k, 3), 6) = 0 Then
                            If i - wd - 1 > 0 Then
                                If aKQ(i - wd - 1, 1) = aTen(k, 1) Then
                                    k = j
                                End If
                            End If
                            If i - wd > 0 Then
                                If aKQ(i - wd, 1) = aTen(k, 1) Then
                                    k = j
                                End If
                            End If
                        ElseIf aTen(j, 3) > aTen(k, 3) Then
                            k = j
                        End If
                    Else
                        If aTen(j, 3) < aTen(k, 3) Then k = j
                    End If
                End If
            End If
        Next
        aKQ(i, 1) = aTen(k, 1)
        aKQ(i, 2) = k
        If k > 0 Then
            If wd > 5 Then
                aTen(k, 2) = aTen(k, 2) + 1
            Else
                aTen(k, 2) = aTen(k, 2) + 1.0001
            End If
            aTen(k, 3) = aTen(k, 2) + 0.5
        End If
        If aNgay(i, k + 1) = sNghiCD Then
            If t < n Then
                t = t + 1
                GoTo Retry
            Else
                aKQ(i, 1) = aTen(0, 1)
            End If
        End If
        t = 0
        If i > x Then
            k = aKQ(i - x, 2)
            If k > 0 Then aTen(k, 3) = aTen(k, 2)
        End If
    Next
    Sheet2.Range("O4").Resize(UBound(aKQ, 1)).Value = aKQ
End Sub

Dạ em đa thử nhưng code của anh chị không cho ra kết quả . Và em lại mò mẫm viết tiếp cái mới sau khi hiểu ý đồ của anh chị nhưng dễ hiểu hơn , có thuyết minh . nó chạy được , không bị bắt lỗi nhưng không ra kết quả . anh chị cao minh sửa lại giúp em . em cảm ơn

 

[huuthang_bd]

Dạ em đa thử nhưng code của anh chị không cho ra kết quả . Và em lại mò mẫm viết tiếp cái mới sau khi hiểu ý đồ của anh chị nhưng dễ hiểu hơn , có thuyết minh . nó chạy được , không bị bắt lỗi nhưng không ra kết quả . anh chị cao minh sửa lại giúp em . em cảm ơn

Bạn trích dẫn bài #42 nên tôi hiểu là bạn nói code ở bài #42 không cho ra kết quả.
Bạn hãy gửi file mà bạn sử dụng code ở bài #42 nhưng không ra kết quả lên, tôi sẽ giúp bạn kiểm tra nguyên nhân.

 

[dangg]

Bạn muốn phân công công bằng nhưng "ý em là" thì lại là người trực hai ngày người không ngày nào (đến 24/10).
Tôi sẽ dừng ở đây, không tham gia code ở chủ đề này nữa.

vâng ạ
Em xin rút kinh nghiệm
Cảm ơn bác ạ!

 

[thierry henry]

Bạn trích dẫn bài #42 nên tôi hiểu là bạn nói code ở bài #42 không cho ra kết quả.
Bạn hãy gửi file mà bạn sử dụng code ở bài #42 nhưng không ra kết quả lên, tôi sẽ giúp bạn kiểm tra nguyên nhân.

dạ không là cái này ạ

Sub Lichtruc8()
Dim cend As Long, arr As Variant, i As Long, j As Long, data As Variant, kq As Variant
Dim rend As Long, d As Long, k
With Sheets("LichTruc")
'Lay dong cuoi va cot cuoi tren sheet LichTruc
rend = .Cells(Rows.Count, 3).End(xlUp).Row
cend = .Cells(3, Columns.Count).End(xlToLeft).Column
kq = .Range(Cells(3, 3), Cells(rend, cend)).Value
On Error Resume Next
ReDim data(1 To UBound(kq, 1), 1 To UBound(kq, 2))
For i = 1 To UBound(kq, 1) 'Duyet qua tung dong cua mang data()
data(i, 1) = kq(i, 1) 'cot A chua ngay thang
Next i
For j = 1 To UBound(kq, 2) 'Duyet qua tung cot cua mang data()
data(1, j) = kq(1, j) 'dong A1 chua thong tin can lay
Next j
ReDim arr(1 To UBound(kq, 1), 1 To 1)
k = 1
For d = k To UBound(kq, 2)
If kq(i, j) = "Ði làm" Then
arr(d, j) = data(1, j)
End If
Next d
.Range("O4:O" & rend).ClearContents
.Range("O4").Value = arr

End With
End Sub

 

[huuthang_bd]

dạ không là cái này ạ

Sub Lichtruc8()
Dim cend As Long, arr As Variant, i As Long, j As Long, data As Variant, kq As Variant
Dim rend As Long, d As Long, k
With Sheets("LichTruc")
'Lay dong cuoi va cot cuoi tren sheet LichTruc
rend = .Cells(Rows.Count, 3).End(xlUp).Row
cend = .Cells(3, Columns.Count).End(xlToLeft).Column
kq = .Range(Cells(3, 3), Cells(rend, cend)).Value
On Error Resume Next
ReDim data(1 To UBound(kq, 1), 1 To UBound(kq, 2))
For i = 1 To UBound(kq, 1) 'Duyet qua tung dong cua mang data()
data(i, 1) = kq(i, 1) 'cot A chua ngay thang
Next i
For j = 1 To UBound(kq, 2) 'Duyet qua tung cot cua mang data()
data(1, j) = kq(1, j) 'dong A1 chua thong tin can lay
Next j
ReDim arr(1 To UBound(kq, 1), 1 To 1)
k = 1
For d = k To UBound(kq, 2)
If kq(i, j) = "Ði làm" Then
arr(d, j) = data(1, j)
End If
Next d
.Range("O4:O" & rend).ClearContents
.Range("O4").Value = arr

End With
End Sub

Code này có phải của tôi đâu bạn. Sao lại trích dẫn bài của tôi và nói là "em đã thử nhưng code của anh chị không cho ra kết quả".

 

[VetMini]

Code này có phải của tôi đâu bạn. Sao lại trích dẫn bài của tôi và nói là "em đã thử nhưng code của anh chị không cho ra kết quả".

Tôi ngỡ bạn dừng ở bài #47 rồi.
Bạn chăm lo chữ "nhẫn" của mình quá nên người ta cứ làm tới, tin rằng có thể lợi dụng.

 

[thierry henry]

Code này có phải của tôi đâu bạn. Sao lại trích dẫn bài của tôi và nói là "em đã thử nhưng code của anh chị không cho ra kết quả".

dạ hình như em quên đưa code lên nên khúc đó anh hiểu nhầm ý em . em nói là code của anh chạy không ra kết quả . nên em mạo muội mò mẫm viết code khác , code chạy nhưng không ra kết quả và nhờ anh sửa bài giúp . có vậy thôi ạ . dù gì em cũng xin cảm ơn

 

[huuthang_bd]

Tôi ngỡ bạn dừng ở bài #47 rồi.
Bạn chăm lo chữ "nhẫn" của mình quá nên người ta cứ làm tới, tin rằng có thể lợi dụng.

Dừng không tham gia code thôi bác.

dạ hình như em quên đưa code lên nên khúc đó anh hiểu nhầm ý em . em nói là code của anh chạy không ra kết quả . nên em mạo muội mò mẫm viết code khác , code chạy nhưng không ra kết quả và nhờ anh sửa bài giúp . có vậy thôi ạ . dù gì em cũng xin cảm ơn

Bạn viết như thế này và tôi hiểu là bạn copy code ở bài 42 về chạy thử nhưng không ra kết quả. Như thế thì nhầm chỗ nào bạn.

 

[thierry henry]

Dừng không tham gia code thôi bác.

Bạn viết như thế này và tôi hiểu là bạn copy code ở bài 42 về chạy thử nhưng không ra kết quả. Như thế thì nhầm chỗ nào bạn.

Dạ thưa các anh chị , em vừa lấy file nguyên thủy chạy thử thì chạy được . Vì file của em đã có nhiều sửa chữa và thử nghiệm nên có lẽ chạy không được . em xin lỗi ạ .