Tạo dropdown nhiều cột dữ liệu

Liên hệ QC

hic1802

Thành viên tiêu biểu
Tham gia
16/2/13
Bài viết
545
Được thích
34
Giới tính
Nam
Chào mọi người trên GPE,
Mình có download trên diễn đàn 1 đoạn code tạo dropdown nhưng cho 2 cột dữ liệu tìm kiếm siêu tốc
Mình có áp dụng vào bài toán bên mình là cho dữ liệu nhiều cột hơn (5 cột)
Mình có chỉnh sửa code nhưng kết quả không theo đúng ý muốn : khi chọn ở cột A sheet2 thì đúng kết quả, chọn cột B thì không đúng kết quả, và mình không biết cách viết thêm code để có thể chọn tìm kiếm ở các cột C,D,E ở sheet2
Nhờ mọi người xem và chỉnh giúp mình xử lý bài toán này với.

Code :
Mã:
Private priArray
Private priColumn As Long
Private priIsFocus As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 And Target.Row > 1 Then
Dim e As Long
Static ArrCode, ArrName
If Target.Column = 1 Then
    If Not IsArray(ArrCode) Then
        e = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
        ArrCode = Sheet1.Range("A2:F" & e).Value2
    End If
    priColumn = 1
    priArray = ArrCode
    Call HienComboBox
ElseIf Target.Column = 2 Then
    If Not IsArray(ArrName) Then
        Dim ArrTmp
        Dim r As Long, u As Long
        e = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
        ArrTmp = Sheet1.Range("A2:A" & e).Value2
        ArrName = Sheet1.Range("B2:D" & e).Value2
        u = UBound(ArrName)
        ReDim Preserve ArrName(1 To u, 1 To 4)
        For r = 1 To u
            ArrName(r, 2) = ArrTmp(r, 1)
        Next
    End If
    priColumn = -1
    priArray = ArrName
    Call HienComboBox

Else
    Call AnComboBox
End If
Else
    Call AnComboBox
End If
End Sub

Private Sub ComboBox1_Change()
    If priIsFocus Then Exit Sub
    If ComboBox1.MatchFound Then
        ActiveCell.Value = ComboBox1.Text
        ActiveCell.Offset(, priColumn).Value = ComboBox1.Column(1)
        ActiveCell.Offset(, 2).Value = ComboBox1.Column(2)
        ActiveCell.Offset(, 3).Value = ComboBox1.Column(3)
        
    Else
        ActiveCell.Value = ""
        ActiveCell.Offset(, priColumn).Value = ""
    End If
End Sub

Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    On Error Resume Next
    Select Case KeyCode
    Case 9, 16, 17, 37 To 40
    Case 13
        ActiveCell.Offset(1).Activate
    Case Else
        Dim strValue As String
        strValue = LCase(ComboBox1.Text)
        ComboBox1.ListRows = 20
        If Trim(strValue) > "" Then
            If IsArray(priArray) Then
                Dim ArrFilter, GetRow()
                Dim c As Long, i As Long, n As Long, r As Long
                For r = 1 To UBound(priArray, 1)
                    If LCase(priArray(r, 1)) Like "*" & strValue & "*" Then
                        n = n + 1
                        ReDim Preserve GetRow(1 To n)
                        GetRow(n) = r
                    End If
                Next
                If n Then
                    Dim u As Byte
                    u = UBound(priArray, 2)
                    ReDim ArrFilter(1 To n, 1 To u)
                    For r = 1 To n
                        For c = 1 To u
                            ArrFilter(r, c) = priArray(GetRow(r), c)
                        Next
                    Next
                    ComboBox1.List = ArrFilter
                Else
                    ComboBox1.Clear
                    ComboBox1.ListRows = 0
                End If
                ComboBox1.DropDown
            End If
        Else
            If ComboBox1.ListCount <> UBound(priArray) Then
                ComboBox1.List = priArray
                ComboBox1.DropDown
            End If
        End If
    End Select
End Sub

Private Sub HienComboBox()
    priIsFocus = True
    With ComboBox1
        .Visible = False
        .Visible = True
        .Left = ActiveCell.Left
        .Top = ActiveCell.Top
        .Width = ActiveCell.Width
        .ListWidth = .Width + ActiveCell.Offset(, priColumn).Width
        .ColumnWidths = .Width - 4
        .Height = ActiveCell.Height
        .List = priArray
        .Text = ""
        .Text = ActiveCell.Value
        .Activate
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
    priIsFocus = False
End Sub

Private Sub AnComboBox()
    With ComboBox1
        If .Visible Then
            .Visible = False
        End If
    End With
End Sub
 

File đính kèm

  • dmhh.xlsm
    354.6 KB · Đọc: 35
Chào mọi người trên GPE,
Mình có download trên diễn đàn 1 đoạn code tạo dropdown nhưng cho 2 cột dữ liệu tìm kiếm siêu tốc
Mình có áp dụng vào bài toán bên mình là cho dữ liệu nhiều cột hơn (5 cột)
Mình có chỉnh sửa code nhưng kết quả không theo đúng ý muốn : khi chọn ở cột A sheet2 thì đúng kết quả, chọn cột B thì không đúng kết quả, và mình không biết cách viết thêm code để có thể chọn tìm kiếm ở các cột C,D,E ở sheet2
Nhờ mọi người xem và chỉnh giúp mình xử lý bài toán này với.

Code :
Mã:
Private priArray
Private priColumn As Long
Private priIsFocus As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 And Target.Row > 1 Then
Dim e As Long
Static ArrCode, ArrName
If Target.Column = 1 Then
    If Not IsArray(ArrCode) Then
        e = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
        ArrCode = Sheet1.Range("A2:F" & e).Value2
    End If
    priColumn = 1
    priArray = ArrCode
    Call HienComboBox
ElseIf Target.Column = 2 Then
    If Not IsArray(ArrName) Then
        Dim ArrTmp
        Dim r As Long, u As Long
        e = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
        ArrTmp = Sheet1.Range("A2:A" & e).Value2
        ArrName = Sheet1.Range("B2:D" & e).Value2
        u = UBound(ArrName)
        ReDim Preserve ArrName(1 To u, 1 To 4)
        For r = 1 To u
            ArrName(r, 2) = ArrTmp(r, 1)
        Next
    End If
    priColumn = -1
    priArray = ArrName
    Call HienComboBox

Else
    Call AnComboBox
End If
Else
    Call AnComboBox
End If
End Sub

Private Sub ComboBox1_Change()
    If priIsFocus Then Exit Sub
    If ComboBox1.MatchFound Then
        ActiveCell.Value = ComboBox1.Text
        ActiveCell.Offset(, priColumn).Value = ComboBox1.Column(1)
        ActiveCell.Offset(, 2).Value = ComboBox1.Column(2)
        ActiveCell.Offset(, 3).Value = ComboBox1.Column(3)
       
    Else
        ActiveCell.Value = ""
        ActiveCell.Offset(, priColumn).Value = ""
    End If
End Sub

Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    On Error Resume Next
    Select Case KeyCode
    Case 9, 16, 17, 37 To 40
    Case 13
        ActiveCell.Offset(1).Activate
    Case Else
        Dim strValue As String
        strValue = LCase(ComboBox1.Text)
        ComboBox1.ListRows = 20
        If Trim(strValue) > "" Then
            If IsArray(priArray) Then
                Dim ArrFilter, GetRow()
                Dim c As Long, i As Long, n As Long, r As Long
                For r = 1 To UBound(priArray, 1)
                    If LCase(priArray(r, 1)) Like "*" & strValue & "*" Then
                        n = n + 1
                        ReDim Preserve GetRow(1 To n)
                        GetRow(n) = r
                    End If
                Next
                If n Then
                    Dim u As Byte
                    u = UBound(priArray, 2)
                    ReDim ArrFilter(1 To n, 1 To u)
                    For r = 1 To n
                        For c = 1 To u
                            ArrFilter(r, c) = priArray(GetRow(r), c)
                        Next
                    Next
                    ComboBox1.List = ArrFilter
                Else
                    ComboBox1.Clear
                    ComboBox1.ListRows = 0
                End If
                ComboBox1.DropDown
            End If
        Else
            If ComboBox1.ListCount <> UBound(priArray) Then
                ComboBox1.List = priArray
                ComboBox1.DropDown
            End If
        End If
    End Select
End Sub

Private Sub HienComboBox()
    priIsFocus = True
    With ComboBox1
        .Visible = False
        .Visible = True
        .Left = ActiveCell.Left
        .Top = ActiveCell.Top
        .Width = ActiveCell.Width
        .ListWidth = .Width + ActiveCell.Offset(, priColumn).Width
        .ColumnWidths = .Width - 4
        .Height = ActiveCell.Height
        .List = priArray
        .Text = ""
        .Text = ActiveCell.Value
        .Activate
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
    priIsFocus = False
End Sub

Private Sub AnComboBox()
    With ComboBox1
        If .Visible Then
            .Visible = False
        End If
    End With
End Sub

Có ai giúp mình vấn đề này với nhỉ???
 
Lần chỉnh sửa cuối:
Vụ đó tôi chưa thử trên file bạn vì không thấy yêu cầu
em thử file bác thì thấy search đc bên cột mã (search sẽ dò theo các số có trong dãy mã đó) nhưng mà nếu search theo tên thì ko ra gì cả, thường thì sẽ search theo tên sẽ ưu tiên hơn là search theo mã
 
em thử file bác thì thấy search đc bên cột mã (search sẽ dò theo các số có trong dãy mã đó) nhưng mà nếu search theo tên thì ko ra gì cả, thường thì sẽ search theo tên sẽ ưu tiên hơn là search theo mã
File bạn hay file tôi là thế nào? Ý bạn muốn nói là file bạn gửi thì search được cả hai, còn tôi gửi lại thì chỉ search được mã chứ tên không được?
 
Xong rồi. Bạn thử lại xem!
bác ơi em hỏi chút, bác đang để cột A là cột tên nhưng gõ tìm là mã và ngược lại cột B là cột mã nhưng gõ tìm lại là tên, mình có thể đúng chiều được không : kiểu côt A là cột tên thì gõ tìm tên, cột B là cột mã thì gõ tìm mã ấy.
 
bác ơi em hỏi chút, bác đang để cột A là cột tên nhưng gõ tìm là mã và ngược lại cột B là cột mã nhưng gõ tìm lại là tên, mình có thể đúng chiều được không : kiểu côt A là cột tên thì gõ tìm tên, cột B là cột mã thì gõ tìm mã ấy.
Bạn thử lại file
 

File đính kèm

  • dmhh_Combobox_hic1802.xlsm
    327.1 KB · Đọc: 43
Web KT
Back
Top Bottom