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ì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