- Tham gia
- 19/5/19
- Bài viết
- 116
- Được thích
- 9
Chào cả nhà GPE. Nhờ mọi người sửa dùm mình sao mình gõ tên hàng là "Bang dien" mà sao không tìm thấy. Em xin chân thành cảm ơn
Code này của bác Hiếu CD tại bài này https://www.giaiphapexcel.com/diend...c-dữ-liệu-siêu-tốc-khoảng-10-000-dòng.131143/
Code:
Code này của bác Hiếu CD tại bài này https://www.giaiphapexcel.com/diend...c-dữ-liệu-siêu-tốc-khoảng-10-000-dòng.131143/
Code:
Mã:
Dim Dic As Object, Test As Boolean, sArr As Variant
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
Range("N4").Value = ListBox1.Value
If Range("N4").Value > 0 Then
Range("O4").Value = ListBox1.List(ListBox1.ListIndex, 0)
Dim i As Long
i = Range("O4").Value + 3
Unload Me
Range("c" & i).Select
End If
End If
End Sub
Private Sub TextBox1_Change()
If Range("B4") <> "" Then
Locspeedtocdo
End If
End Sub
Private Sub Locspeedtocdo()
On Error Resume Next
Dim arr(), dArr(), i As Long, k As Long, dk As String, lcol As Byte
If Test = False Then Call Add_Dic
If Not IsArray(sArr) Then Call Add_Data
dk = Up_TV_KhongDau(UCase(TextBox1.Value))
lcol = UBound(sArr, 2)
ReDim arr(1 To 1)
For i = 1 To UBound(sArr)
If sArr(i, lcol) Like "*" & dk & "*" Then
k = k + 1
ReDim Preserve arr(1 To k)
arr(k) = i
End If
Next
ReDim dArr(1 To k, 1 To lcol - 1)
For i = 1 To UBound(arr)
For J = 1 To lcol - 1
dArr(i, J) = sArr(arr(i), J)
Next J
Next
ListBox1.Clear
ListBox1.ColumnCount = lcol
ListBox1.List = dArr
End Sub
Private Sub Add_Data()
Dim dArr As Variant, Tmp As String, i As Long, k As Long, lcol As Byte
If Range("c5003") = "" Then
i = Range("c5003").End(xlUp).Row ' O cuoi cot ben Trai
Else
i = 5003
End If
dArr = Range("a4:g" & i).Value ' Vung can Tim kiem
lcol = UBound(dArr, 2)
ReDim sArr(1 To UBound(dArr), 1 To lcol + 1)
For i = 1 To UBound(dArr)
Tmp = dArr(i, 3) ' loc theo cot Ten hang
k = k + 1
Tmp = Up_TV_KhongDau(UCase(Tmp))
sArr(k, lcol + 1) = Tmp
For J = 1 To lcol
sArr(k, J) = dArr(i, J)
Next J
Next i
End Sub
Private Sub Add_Dic()
Dim CharCode, ResText As String, i As Byte
Set Dic = CreateObject("scripting.dictionary")
CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
For i = 0 To UBound(CharCode)
'Dic.Add CharCode(i), Mid(ResText, i + 1, 1)
Dic.Add UCase(CharCode(i)), UCase(Mid(ResText, i + 1, 1))
Next
Test = True
End Sub
Private Function Up_TV_KhongDau(ByVal Text As String) As String ' bo dau tieng viet
Dim i As Long, key As String
If Len(Text) = 0 Then Up_TV_KhongDau = "": Exit Function
For i = 1 To Len(Text)
key = Mid(Text, i, 1)
If Dic.exists(key) Then Mid(Text, i, 1) = Dic.Item(key)
Next
Up_TV_KhongDau = Text
End Function
Private Sub UserForm_Initialize()
If Test = False Then Call Add_Dic
If Not IsArray(sArr) Then Call Add_Data
End Sub
Lần chỉnh sửa cuối:
