Tạo list chọn WO theo điều kiện.

[phuongdt_tk1]

Chào các anh chị.
Các anh chị giúp em tạo cái list này bằng VBA với ạ.
Em xin cảm ơn.

 

[snow25]

Chào các anh chị.
Các anh chị giúp em tạo cái list này bằng VBA với ạ.
Em xin cảm ơn.

Bạn thử nhé.

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.ScreenUpdating = False
  Application.EnableEvents = False
        Dim arr, S As String, dic As Object, dk As String, dks As String, lr As Long, i As Long
        If Target.Address(0, 0) = "E1" Then
           dks = Target.Value
           Set dic = CreateObject("scripting.dictionary")
           With Sheets("data")
                lr = .Range("A" & Rows.Count).End(xlUp).Row
                arr = .Range("A2:B" & lr).Value
           End With
               For i = 1 To UBound(arr)
                   If dks = arr(i, 2) Then
                      dk = arr(i, 1)
                      If Not dic.exists(dk) Then
                         dic.Add dk, ""
                         S = S & "," & dk
                      End If
                   End If
               Next i
               With Range("B1").Validation
                    .Delete
                    If Len(S) Then
                       S = Right(S, Len(S) - 1)
                       .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=S
                    End If
              End With
       End If
     Application.ScreenUpdating = True
     Application.EnableEvents = True
End Sub

 

[phuongdt_tk1]

Bạn thử nhé.

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.ScreenUpdating = False
  Application.EnableEvents = False
        Dim arr, S As String, dic As Object, dk As String, dks As String, lr As Long, i As Long
        If Target.Address(0, 0) = "E1" Then
           dks = Target.Value
           Set dic = CreateObject("scripting.dictionary")
           With Sheets("data")
                lr = .Range("A" & Rows.Count).End(xlUp).Row
                arr = .Range("A2:B" & lr).Value
           End With
               For i = 1 To UBound(arr)
                   If dks = arr(i, 2) Then
                      dk = arr(i, 1)
                      If Not dic.exists(dk) Then
                         dic.Add dk, ""
                         S = S & "," & dk
                      End If
                   End If
               Next i
               With Range("B1").Validation
                    .Delete
                    If Len(S) Then
                       S = Right(S, Len(S) - 1)
                       .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=S
                    End If
              End With
       End If
     Application.ScreenUpdating = True
     Application.EnableEvents = True
End Sub

Anh ơi. Cái diều kiện nó không hoạt động. nó chỉ nhận cái đã chọn là "Printed" còn cái "No print" thì không chạy

 

[snow25]

Anh ơi. Cái diều kiện nó không hoạt động. nó chỉ nhận cái đã chọn là "Printed" còn cái "No print" thì không chạy

Bạn xem lại của mình có hết mà.

 

[phuongdt_tk1]

Bạn xem lại của mình có hết mà.

Thank you very much.
Mình mày mò mãi không ra.
Quá xanh và non về VBA hic. hic