Lọc dữ liệu trong Data Validation

[huongmuine]

Mình có mã nhân viên như sheet1 của file. Mình muốn tại 1 ô của sheet2 dùng code trong Data Validation để khi nhập 1 ký tự thì trong list của Data Validation chỉ hiển thị những mã nhân viên có ký tự giống với ký tự vừa nhập. Xin cảm ơn.

 

[leonguyenz]

Bạn tham khảo code sau:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$3" Then
    Range("C3").Validation.Delete
    Dim sArr(), dVa As Long, Dic As Object, CtD As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheet1.Range("A3:A" & Sheet1.Range("A65535").End(xlUp).Row)
    For dVa = 1 To UBound(sArr)
        If UCase(sArr(dVa, 1)) Like "*" & UCase(Target.Value) & "*" Then
            If Not Dic.Exists(sArr(dVa, 1)) Then
                CtD = CtD + 1
                Dic.Add sArr(dVa, 1), CtD
            End If
        End If
    Next dVa
    If CtD Then
        With Range("C3").Validation
            .Delete
            .Add xlValidateList, , , Join(Dic.Keys, ",")
            .ShowError = False
        End With
    End If
    Set Dic = Nothing
End If
End Sub

 

[huongmuine]

Bạn tham khảo code sau:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$3" Then
    Range("C3").Validation.Delete
    Dim sArr(), dVa As Long, Dic As Object, CtD As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheet1.Range("A3:A" & Sheet1.Range("A65535").End(xlUp).Row)
    For dVa = 1 To UBound(sArr)
        If UCase(sArr(dVa, 1)) Like "*" & UCase(Target.Value) & "*" Then
            If Not Dic.Exists(sArr(dVa, 1)) Then
                CtD = CtD + 1
                Dic.Add sArr(dVa, 1), CtD
            End If
        End If
    Next dVa
    If CtD Then
        With Range("C3").Validation
            .Delete
            .Add xlValidateList, , , Join(Dic.Keys, ",")
            .ShowError = False
        End With
    End If
    Set Dic = Nothing
End If
End Sub

Rất cảm ơn bạn. Kết quả như mình mong muốn.

 

[khanhhero]

Bạn tham khảo code sau:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$3" Then
    Range("C3").Validation.Delete
    Dim sArr(), dVa As Long, Dic As Object, CtD As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheet1.Range("A3:A" & Sheet1.Range("A65535").End(xlUp).Row)
    For dVa = 1 To UBound(sArr)
        If UCase(sArr(dVa, 1)) Like "*" & UCase(Target.Value) & "*" Then
            If Not Dic.Exists(sArr(dVa, 1)) Then
                CtD = CtD + 1
                Dic.Add sArr(dVa, 1), CtD
            End If
        End If
    Next dVa
    If CtD Then
        With Range("C3").Validation
            .Delete
            .Add xlValidateList, , , Join(Dic.Keys, ",")
            .ShowError = False
        End With
    End If
    Set Dic = Nothing
End If
End Sub

Nếu trường hợp tên tìm kiếm cho chứa dấu "," thì phương án trên không được rồi anh.