Nhờ mọi người giúp cách xóa các mục đã chọn trong Droplist của một nhóm các ô cùng dạy một môn học. (1 người xem)

vinhphtdp đã viết:

Nhờ các chuyên gia giải quyết giúp bài toán sau:
Mình đã làm làm mẫu PCCM khi nhập chỉ cần chọn lớp từ Droplist, đã xây dựng code VBA để chọn nhiều lớp cho từng GV và muốn bỏ 1 lớp khi chọn nhầm thì chỉ cần chọn lại lớp đấy. Nhưng có 1 vấn đề là khi đã chọn các lớp cho 1 GV rồi thì các GV còn lại sẽ không có các lớp đã chọn trong Droplist nhưng mình không viết được. Nhờ mọi người chỉ giúp.

Nhấp chuột vào đây để mở rộng...

Sub AddLists1(ByVal C As Integer)
    Dim Sh As Worksheet, Ws As Worksheet
    Dim cell As Range, Data(), PhCong()
    Dim i&, j&, Col&
    Dim DictMon As Object, Key
    Set Sh = ThisWorkbook.Sheets("Data")
    Set Ws = Sheets("Phancong 25-26")
        If C = 14 Then Col = 2
        If C = 15 Then Col = 22
        If C = 17 Then Col = 12

    Set Dic = CreateObject("Scripting.Dictionary")
    Set DictMon = CreateObject("Scripting.Dictionary")
        Data = Sh.Range(Sh.Cells(4, Col), Sh.Cells(35, Col)).Value
        PhCong = Ws.Range(Ws.Cells(12, C), Ws.Cells(26, C)).Value

    For j = 1 To UBound(PhCong)
        If PhCong(j, 1) <> Empty Then
            Key = PhCong(j, 1)
            If Not DictMon.Exists(Key) Then DictMon.Add (Key), j
        End If
    Next j

    For j = 1 To UBound(Data)
            Key = Data(j, 1)
            If Not DictMon.Exists(Key) Then Dic.Add (Key), j
    Next j

    Ws.Range(Ws.Cells(12, C), Ws.Cells(26, C)).Validation.Delete
    Ws.Range(Ws.Cells(12, C), Ws.Cells(26, C)).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(Dic.keys, ",")
End Sub

.......
Else
            If oldValue <> "" Then
                 Target.Value = oldValue & delimiter & newValue
            Else
                Target.Value = newValue
            End If
.......

....
Else
            If oldValue <> "" Then
                 Target.Value = oldValue & delimiter & newValue
            Else
                Target.Value = newValue
            End If

Call AddLists1(Target.Column)
            .....

HUONGHCKT đã viết:

Tôi không phải là chuyên gia gì cả nên chỉ có thể góp ý với bạn thế này:
Khi đã chọn 1 lớp nào đó thì tên lớp đó không có trong DropList nữa (như bạn đã muốn)-Điều này là hoàn toàn có thể .
Tham khảo code dưới đây

Mã: Sao chép.

Sub AddLists1(ByVal C As Integer)
    Dim Sh As Worksheet, Ws As Worksheet
    Dim cell As Range, Data(), PhCong()
    Dim i&, j&, Col&
    Dim DictMon As Object, Key
    Set Sh = ThisWorkbook.Sheets("Data")
    Set Ws = Sheets("Phancong 25-26")
        If C = 14 Then Col = 2
        If C = 15 Then Col = 22
        If C = 17 Then Col = 12

    Set Dic = CreateObject("Scripting.Dictionary")
    Set DictMon = CreateObject("Scripting.Dictionary")
        Data = Sh.Range(Sh.Cells(4, Col), Sh.Cells(35, Col)).Value
        PhCong = Ws.Range(Ws.Cells(12, C), Ws.Cells(26, C)).Value

    For j = 1 To UBound(PhCong)
        If PhCong(j, 1) <> Empty Then
            Key = PhCong(j, 1)
            If Not DictMon.Exists(Key) Then DictMon.Add (Key), j
        End If
    Next j

    For j = 1 To UBound(Data)
            Key = Data(j, 1)
            If Not DictMon.Exists(Key) Then Dic.Add (Key), j
    Next j

    Ws.Range(Ws.Cells(12, C), Ws.Cells(26, C)).Validation.Delete
    Ws.Range(Ws.Cells(12, C), Ws.Cells(26, C)).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(Dic.keys, ",")
End Sub

và thêm dòng code sau trong Sub Worksheet_Change

Mã: Sao chép.

.......
Else
            If oldValue <> "" Then
                 Target.Value = oldValue & delimiter & newValue
            Else
                Target.Value = newValue
            End If
.......

thành

Mã: Sao chép.

....
Else
            If oldValue <> "" Then
                 Target.Value = oldValue & delimiter & newValue
            Else
                Target.Value = newValue
            End If

Call AddLists1(Target.Column)
            .....

Nhưng, khi bạn muốn bỏ 1 lớp do chọn nhầm rồi thì bạn không thể chọn lại bởi : lớp đó không có trong Droplist nữa thì lấy đâu mà chọn.
Do vậy, để vẫn cho phép xóa bỏ lớp đã chọn nhầm và đảm bảo cho các giáo viên sẽ không chọn được lớp đã được chọn là dùng cảnh báo và Droplist vẫn có đủ các lớp (tức là vẫn nguyên từ dòng 4 đến dòng 35 của sheets Data: Nếu chọn 1 lớp mà trước đó đã phân công cho giáo viên khác rồi thì sẽ xuất hiện 1 thông báo "Lớp này đã được chọn-Hãy chọn lớp khác"
Hỏi thêm bạn là sao có đến 14 môn mà sao trong sh Phancong lại chỉ có 3 môn, sao bạn không làm cả 14 môn rồi dùng code để khi chọn tổ thì các môn của tổ đó được hiện còn các môn tổ khác bị ẩn.

Nhấp chuột vào đây để mở rộng...

vinhphtdp đã viết:

Cảm ơn bạn rất nhiều. Nếu được bạn giúp mình nhé. Do mình cũng chỉ mới bắt đầu VBA nên đang dùng code trợ giúp.

Nhấp chuột vào đây để mở rộng...