quangpro779
Thành viên mới
- Tham gia
- 3/7/21
- Bài viết
- 6
- Được thích
- 1
Em chào mọi người !
Em có dùng code tìm kiếm trong form này của bác @HieuCD lâu rồi em cũng không nhớ link cũ nằm ở đâu nữa. Code tìm kiếm rất hay và nhanh. Hiện tại code tìm kiếm theo phương thức bất kỳ đâu trên chuỗi. Giờ em muốn sửa lại theo từ trái qua phải thì phải làm sao. Tại vì Tên học sinh có rất nhiều trường hợp Họ giống Tên, nên em tìm kiếm nó ra trùng rất nhiều. em xin cảm ơn các bác ạ
Em có dùng code tìm kiếm trong form này của bác @HieuCD lâu rồi em cũng không nhớ link cũ nằm ở đâu nữa. Code tìm kiếm rất hay và nhanh. Hiện tại code tìm kiếm theo phương thức bất kỳ đâu trên chuỗi. Giờ em muốn sửa lại theo từ trái qua phải thì phải làm sao. Tại vì Tên học sinh có rất nhiều trường hợp Họ giống Tên, nên em tìm kiếm nó ra trùng rất nhiều. em xin cảm ơn các bác ạ
Mã:
Dim dic As Object, Test As Boolean, sArr As Variant
Private Sub TextBox1_Change()
locnhapkhonewa
End Sub
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
i = Sheets("Sheet1").Range("B65500").End(xlUp).Row
dArr = Sheets("Sheet1").Range("B4:H" & i).Value
lcol = UBound(dArr, 2)
ReDim sArr(1 To UBound(dArr), 1 To lcol + 1)
For i = 1 To UBound(dArr)
tmp = dArr(i, 1) & " " & dArr(i, 2)
If dArr(i, 1) <> "" Or dArr(i, 1) <> " " Then
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
End If
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:
