Viết Code Di Chuyển Kí Tự (2 người xem)

vuongtoituonglai · 30/9/15

Viết Code Phân Công Lịch Trực

Chào anh/chị và các bán
Mình có 1 file excel cần di chuyển kí tự theo điều kiện, rất mong các anh chị và các bạn giúp dùm.
Tất cả nội dung mô tả đều có trong file
Chân thành cảm ơn

giaiphap · 30/9/15

vuongtoituonglai đã viết:
Chào anh/chị và các bán
Mình có 1 file excel cần di chuyển kí tự theo điều kiện, rất mong các anh chị và các bạn giúp dùm.
Tất cả nội dung mô tả đều có trong file
Chân thành cảm ơn

Mà chứ O di chuyển đi đâu (Lên, xuống, trái, phải hay tùy ý thích chổ nào di chuyển chổ đó)

befaint · 30/9/15

"Di chuyển" di chuyển làm sao?
Tôi nghĩ là nên đổi lại tiêu đề topic thành bài toán lập kế hoạch / phân lịch trực, với quy luật theo file ở bài #1 như sau:
- Có 7 nhóm (mỗi nhóm có từ 2-4 người).
- Mỗi ngày trong tháng chỉ duy nhất có 1 người phải làm (điều kiện theo hàng / cột = 1), ngày kế tiếp là người thuộc nhóm kế tiếp làm (không tính thứ 7 và chủ nhật)
Nếu đúng như vậy thì ... cái này tôi chịu, ngồi hóng.

vuongtoituonglai · 1/10/15

giaiphap đã viết:
Mà chứ O di chuyển đi đâu (Lên, xuống, trái, phải hay tùy ý thích chổ nào di chuyển chổ đó)

Cảm ơn bạn, chữ "O" di chuyển tự do nhưng phải thỏa mãn 2 điều kiện mình đã nêu.

vuongtoituonglai · 1/10/15

befaint đã viết:
"Di chuyển" di chuyển làm sao?
Tôi nghĩ là nên đổi lại tiêu đề topic thành bài toán lập kế hoạch / phân lịch trực, với quy luật theo file ở bài #1 như sau:
- Có 7 nhóm (mỗi nhóm có từ 2-4 người).
- Mỗi ngày trong tháng chỉ duy nhất có 1 người phải làm (điều kiện theo hàng / cột = 1), ngày kế tiếp là người thuộc nhóm kế tiếp làm (không tính thứ 7 và chủ nhật)
Nếu đúng như vậy thì ... cái này tôi chịu, ngồi hóng.

Cảm ơn bạn, đúng như bạn đã nêu nhưng ở đây không phân biệt nhóm.

sealand · 1/10/15

Có thể tạm thời phân tích bài toán như sau:

-Yêu cầu 1 vòng trưc là mỗi người 1 lần thì số lượt tua lại là 4 tua (Số người tối đa của 1 nhóm)
-Yêu cầu người trực đầu tiên của ngày 1/1 trong năm

Ta sẽ đi lập bảng tra lịch trực cho 1 tháng bất kỳ trong năm đó. Việc này phải tính theo năm mới thống nhất lịch trực trong năm. Tránh trường hợp xếp ngẫu nhiên mỗi lần xem 1 khác.

Vậy thì phải xác định các nhón có ít hơn 4 người sẽ nghỉ ở tua nào hay cứ lần lượt nếu đã trực hết sẽ bỏ qua nhóm. Trong ví dụ thì hình như có quy định cụ thể thì phải.

vuongtoituonglai · 1/10/15

sealand đã viết:
Có thể tạm thời phân tích bài toán như sau:

-Yêu cầu 1 vòng trưc là mỗi người 1 lần thì số lượt tua lại là 4 tua (Số người tối đa của 1 nhóm)
-Yêu cầu người trực đầu tiên của ngày 1/1 trong năm

Ta sẽ đi lập bảng tra lịch trực cho 1 tháng bất kỳ trong năm đó. Việc này phải tính theo năm mới thống nhất lịch trực trong năm. Tránh trường hợp xếp ngẫu nhiên mỗi lần xem 1 khác.

Vậy thì phải xác định các nhón có ít hơn 4 người sẽ nghỉ ở tua nào hay cứ lần lượt nếu đã trực hết sẽ bỏ qua nhóm. Trong ví dụ thì hình như có quy định cụ thể thì phải.

Cảm ơn bạn đã quan tâm đến đề tài này mong bạn giúp đỡ.
Mình xin giải thích thêm như sau:
Mình lấy tháng 9/2015 làm góc, người trực đầu tiên trong tháng 9 thì sang tháng 10 cũng là người trực đầu tiên và các tháng tiếp theo cũng như vậy, những người khác cũng tương tự như vậy nhưng không phân bổ vào thứ 7 và chủ nhật.

vuongtoituonglai · 2/10/15

vuongtoituonglai đã viết:
Cảm ơn bạn đã quan tâm đến đề tài này mong bạn giúp đỡ.
Mình xin giải thích thêm như sau:
Mình lấy tháng 9/2015 làm góc, người trực đầu tiên trong tháng 9 thì sang tháng 10 cũng là người trực đầu tiên và các tháng tiếp theo cũng như vậy, những người khác cũng tương tự như vậy nhưng không phân bổ vào thứ 7 và chủ nhật.

Không biết đề tài của mình có khó không nhưng không thấy bạn nào giúp mình cả.
Nếu không dùng Code thì có hàm nào trong excel có thể thực hiện được chủ đề của mình không. Có ai biết vui lòng giúp dùm.
Cảm ơn

mayan · 2/10/15

vuongtoituonglai đã viết:
Không biết đề tài của mình có khó không nhưng không thấy bạn nào giúp mình cả.
Nếu không dùng Code thì có hàm nào trong excel có thể thực hiện được chủ đề của mình không. Có ai biết vui lòng giúp dùm.
Cảm ơn

Thử ngâm cứu nhưng thấy bài toán của bạn có nhiều chổ chưa hiểu:
- Ví dụ : tháng 7/2015 có 23 ngày làm việc thì có 1 người trực 2 lần ?
- Tháng 2/2015 chỉ có 20 ngày làm việc thì có 2 người không có lịch trực?
Vậy số người làm việc là cố định 22 người hay thay đổi theo số ngày trong tháng?

vuongtoituonglai · 3/10/15

mayan đã viết:
Thử ngâm cứu nhưng thấy bài toán của bạn có nhiều chổ chưa hiểu:
- Ví dụ : tháng 7/2015 có 23 ngày làm việc thì có 1 người trực 2 lần ?
- Tháng 2/2015 chỉ có 20 ngày làm việc thì có 2 người không có lịch trực?
Vậy số người làm việc là cố định 22 người hay thay đổi theo số ngày trong tháng?

Số người làm việc là cố định, tháng nào có ít ngày làm việc thì những người trực cuối cùng sẽ không có lịch trựctrực.

gtri · 4/10/15

vuongtoituonglai đã viết:
Chào anh/chị và các bán
Mình có 1 file excel cần di chuyển kí tự theo điều kiện, rất mong các anh chị và các bạn giúp dùm.
Tất cả nội dung mô tả đều có trong file
Chân thành cảm ơn

Tạm thời nhấn vào mũi tên để chuyển
Chữ "O" lần đầu nhập bằng tay, mỗi lần nhấn sẽ dịch chuyển sang ngang
---

Sửa lại, chạy trên mảng cho nhanh hơn

Mã:

Public Sub Di_Chuyen()
Dim DL, TieuDe, dong, dich, r As Long, c As Long, tg

tg = Timer
TieuDe = Sheet1.Range("D6:AH6")
DL = Sheet1.Range("D7:AH28")

For c = 1 To UBound(DL, 2)
If Right(TieuDe(1, (c Mod UBound(DL, 2)) + 1), 1) = 7 Then
dich = 3
Else
dich = 1
End If

For r = 1 To UBound(DL)
If r <> dong Then
If DL(r, c) = "O" Then
DL(r, c) = ""
DL(r, (c Mod UBound(DL, 2)) + dich) = "O"
dong = r
Exit For
End If
End If
Next r

Next c
Sheet1.Range("D7:AH28").ClearContents
Sheet1.Range("D7:AH28") = DL
Sheet1.Range("AK1") = Timer - tg
End Sub

vuongtoituonglai · 5/10/15

gtri đã viết:
Tạm thời nhấn vào mũi tên để chuyển
Chữ "O" lần đầu nhập bằng tay, mỗi lần nhấn sẽ dịch chuyển sang ngang
---

Sửa lại, chạy trên mảng cho nhanh hơn

Mã:

Public Sub Di_Chuyen() Dim DL, TieuDe, dong, dich, r As Long, c As Long, tg tg = Timer TieuDe = Sheet1.Range("D6:AH6") DL = Sheet1.Range("D7:AH28") For c = 1 To UBound(DL, 2) If Right(TieuDe(1, (c Mod UBound(DL, 2)) + 1), 1) = 7 Then dich = 3 Else dich = 1 End If For r = 1 To UBound(DL) If r <> dong Then If DL(r, c) = "O" Then DL(r, c) = "" DL(r, (c Mod UBound(DL, 2)) + dich) = "O" dong = r Exit For End If End If Next r Next c Sheet1.Range("D7:AH28").ClearContents Sheet1.Range("D7:AH28") = DL Sheet1.Range("AK1") = Timer - tg End Sub

[/QU
Cảm ơn bạn đã giúp đỡ, file đính kèm khi chuyển qua tháng 1 năm 2016 nhấp vào mũi tên một hồi thì chữ O chạy ra ngoài cột AI. Code chạy trên mảng khi chuyển qua tháng 1 năm 2016 nhấp vào mũi tên vài lần thì code báo lỗi. Bạn nghiêng cứu chỉnh lại dùm mình nhé.
Cảm ơn bạn

gtri · 5/10/15

---------------------------------------

gtri · 6/10/15

Bạn xem file đính kèm.
- Số liệu lần đầu nhập tay
- D30:AH30 để nguyên công thức không xóa
- Nhập ngày đầu tháng vào D5 sheet KH
- Tổng số chữ "O" <= tổng ngày làm việc -1

Mã:

Public Sub Di_Chuyen()
Dim DL As Range, TieuDe As Range, TgR As Range
Dim dich, r As Long, c As Long, cl As Long

Application.ScreenUpdating = False

Set TieuDe = Sheet1.Range("D6:AH6")
Set DL = Sheet1.Range("D7:AH28")
Set TgR = Sheet1.Range("D30:AH30")

For c = 1 To DL.Columns.Count

For r = 1 To DL.Rows.Count
If DL(r, c) = "O" Then
DL(r, c) = ""

For cl = c + 1 To DL.Columns.Count + c - 1
dich = (cl - 1) Mod DL.Columns.Count + 1
If Right(TieuDe(1, dich), 1) <> 7 And Application.Trim(TieuDe(1, dich)) <> "C N" And TgR(1, dich) = 0 Then
DL(r, dich) = "O"
Exit For
End If
Next cl

End If
Next r

Next c

Application.ScreenUpdating = True
End Sub

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$5" Then
Call Di_Chuyen
End If
End Sub

vuongtoituonglai · 6/10/15

gtri đã viết:

Bạn xem file đính kèm.
- Số liệu lần đầu nhập tay
- D30:AH30 để nguyên công thức không xóa
- Nhập ngày đầu tháng vào D5 sheet KH
- Tổng số chữ "O" <= tổng ngày làm việc -1

Mã:

Public Sub Di_Chuyen()
Dim DL As Range, TieuDe As Range, TgR As Range
Dim dich, r As Long, c As Long, cl As Long

Application.ScreenUpdating = False

Set TieuDe = Sheet1.Range("D6:AH6")
Set DL = Sheet1.Range("D7:AH28")
Set TgR = Sheet1.Range("D30:AH30")

For c = 1 To DL.Columns.Count

For r = 1 To DL.Rows.Count
If DL(r, c) = "O" Then
DL(r, c) = ""

For cl = c + 1 To DL.Columns.Count + c - 1
dich = (cl - 1) Mod DL.Columns.Count + 1
If Right(TieuDe(1, dich), 1) <> 7 And Application.Trim(TieuDe(1, dich)) <> "C N" And TgR(1, dich) = 0 Then
DL(r, dich) = "O"
Exit For
End If
Next cl

End If
Next r

Next c

Application.ScreenUpdating = True
End Sub

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$5" Then
Call Di_Chuyen
End If
End Sub

cảm ơn bạn, có vài chổ nhờ bạn xem xét và chỉnh sửa lại dùm mình.
1. Tháng 10/2015 có 23 ngày làm việc như vậy sẽ có 22 phải trực.
2. Tháng 11/2015 có 21 ngày làm việc như vậy sẽ có 21 người trực.
3. Tháng 12/2015 có 23 ngày làm việc như vậy sẽ có 22 phải trực nhưng kết quả chỉ có 21 người trực

gtri · 6/10/15

vuongtoituonglai đã viết:
cảm ơn bạn, có vài chổ nhờ bạn xem xét và chỉnh sửa lại dùm mình.
1. Tháng 10/2015 có 23 ngày làm việc như vậy sẽ có 22 phải trực.
2. Tháng 11/2015 có 21 ngày làm việc như vậy sẽ có 21 người trực.
3. Tháng 12/2015 có 23 ngày làm việc như vậy sẽ có 22 phải trực nhưng kết quả chỉ có 21 người trực

Theo bài 14
- Việc phân bố lịch là theo bảng 31 cột, chưa theo tháng nên số lượng người trực bị tính tràn sang tháng kế tiếp ( Nếu tháng tính toán < 31 ngày )
- Vì số người lần đầu tiên nhập tay nên tổng số lượng người trực luôn bị cố định

Để sửa code có lẽ cần làm rõ yếu tố này:
Giả định tháng hiện tại là 10/2015 ( 31 ngày ): Tổng ngày làm việc là 22, tổng người làm việc là 21
Khi chuyển sang tháng 11/2015 ( 30 ngày ) : Tổng ngày làm việc là 21, tổng người làm việc là 20
Tức là số người tháng mới sẽ giảm=> Nguyên tắc bớt đi là thế nào?
Đây là trường hợp giảm đi.

Trường hợp tăng thêm thì bạn cũng làm rõ luôn nguyên tắc phân bố bổ sung thế nào.
Việc thêm vào áp dụng cho những người cuối danh sách liệu có được hay không?

Ý bên dưới này sẽ luôn áp cho mọi tháng?
Nếu đúng như vậy thì có thể sẽ có 1 vài "O" không di chuyển nếu ngày đấu tiên của các tháng liên tiếp đều <>T7 và <> CN

vuongtoituonglai đã viết:
người trực đầu tiên trong tháng 9 thì sang tháng 10 cũng là người trực đầu tiên và các tháng tiếp theo cũng như vậy, những người khác cũng tương tự như vậy nhưng không phân bổ vào thứ 7 và chủ nhật.

---

Việc phân bổ lần đầu tiên cho mọi tháng là nhập tay thì có lẽ tiện hơn

gtri · 6/10/15

Gửi file tạm tính theo các yêu cầu của bạn.
Nếu không phân công trước, lịch trực sẽ phân bố tuần tự từ trên xuống
Tổng người làm việc = Tổng ngày làm việc ( Nếu đủ người )
Tạm thời nhập ngày đầu tháng vào D5 để chạy

vuongtoituonglai · 10/10/15

gtri đã viết:
Gửi file tạm tính theo các yêu cầu của bạn.
Nếu không phân công trước, lịch trực sẽ phân bố tuần tự từ trên xuống
Tổng người làm việc = Tổng ngày làm việc ( Nếu đủ người )
Tạm thời nhập ngày đầu tháng vào D5 để chạy

Cảm ơn bạn, đúng như bạn nhận định lịch trực nên nhập thủ công thì chủ động hơn. Mình có thêm gợi ý trong file đính kèm bạn xem có hướng giải quyết không. Mong bạn xem và giúp đỡ.

gtri · 16/10/15

vuongtoituonglai đã viết:
Cảm ơn bạn, đúng như bạn nhận định lịch trực nên nhập thủ công thì chủ động hơn. Mình có thêm gợi ý trong file đính kèm bạn xem có hướng giải quyết không. Mong bạn xem và giúp đỡ.

Mã:

Public Sub Lich_Truc()
Dim Thu, Lich, kq(), r As Long, c As Long, i

With Sheet1
r = .Range("C7").End(xlDown).Row
For c = 5 To .UsedRange.Columns.Count
If Val(.Cells(5, c)) > Val(.Cells(5, c + 1)) Then Exit For
Next c

.Range("D7", "AH" & r).ClearContents
Thu = .Range(.Cells(6, 4), .Cells(6, c))
Lich = .Range("AK7", "AK" & r)
ReDim kq(1 To r, 1 To c)

For c = 1 To UBound(Thu, 2)
If Right(Thu(1, c), 1) <> 7 And Application.Trim(Thu(1, c)) <> "C N" Then
i = i + 1
For r = 1 To UBound(Lich)
If Lich(r, 1) = i Then kq(r, c) = "O": Exit For
Next r
End If
Next c

.Range("D7").Resize(UBound(kq), UBound(kq, 2)) = kq
End With
End Sub

vuongtoituonglai · 18/10/15

gtri đã viết:

Mã:

Public Sub Lich_Truc()
Dim Thu, Lich, kq(), r As Long, c As Long, i

With Sheet1
r = .Range("C7").End(xlDown).Row
For c = 5 To .UsedRange.Columns.Count
If Val(.Cells(5, c)) > Val(.Cells(5, c + 1)) Then Exit For
Next c

.Range("D7", "AH" & r).ClearContents
Thu = .Range(.Cells(6, 4), .Cells(6, c))
Lich = .Range("AK7", "AK" & r)
ReDim kq(1 To r, 1 To c)

For c = 1 To UBound(Thu, 2)
If Right(Thu(1, c), 1) <> 7 And Application.Trim(Thu(1, c)) <> "C N" Then
i = i + 1
For r = 1 To UBound(Lich)
If Lich(r, 1) = i Then kq(r, c) = "O": Exit For
Next r
End If
Next c

.Range("D7").Resize(UBound(kq), UBound(kq, 2)) = kq
End With
End Sub

Cảm ơn bạn, Tháng 11, 12/2015 code chạy cho kết quả đúng qua tháng 01/2016 khi chạy code thì các chữ "O" bị xóa hết và khi chạy code của những tháng đã qua chữ "O" cũng bị xóa hết.
Bạn kiểm tra code và chỉnh sửa dùm mình chổ này nhé.

Viết Code Di Chuyển Kí Tự (2 người xem)

Người dùng đang xem chủ đề này

Thành viên thường trực

File đính kèm

==(^o^)==

|||||||||||||

Thành viên thường trực

Thành viên thường trực

Thành viên gạo cội

Thành viên thường trực

Thành viên thường trực

Thành viên mới

Thành viên thường trực

Thành viên tích cực

File đính kèm

Thành viên thường trực

Thành viên tích cực

Thành viên tích cực

File đính kèm

Thành viên thường trực

Thành viên tích cực

Thành viên tích cực

File đính kèm

Thành viên thường trực

File đính kèm

Thành viên tích cực

Thành viên thường trực

Đếm ngược thời gian