Tôi mới cải tiến chút về hàm này, không biết có cách nào nhanh hơn và gọn hơn hay không? Ở đây là kết hợp hàm Proper và hàm Trim nên thấy hơi dài dòng, nhưng lại hiệu quả.
Các bạn tham khảo:
PHP:
Function MyUniProper(MyTextUni As String) As String
Dim MyChar As String, MyProper As String, LenChar As Long, Tmp As String
MyTextUni = " " & LCase(MyTextUni)
For LenChar = 2 To Len(MyTextUni)
MyChar = Mid(MyTextUni, LenChar, 1)
If Mid(MyTextUni, LenChar - 1, 1) = " " Then
If AscW(MyChar) < 256 Then MyChar = UCase(MyChar) Else MyChar = ChrW(AscW(MyChar) - 1)
End If
MyProper = MyProper & MyChar
Next
Tmp = Trim(MyProper)
Do While InStr(Tmp, Space(2))
Tmp = Replace(Tmp, Space(2), Space(1))
Loop
MyUniProper = Tmp
End Function
Tôi mới cải tiến chút về hàm này, không biết có cách nào nhanh hơn và gọn hơn hay không? Ở đây là kết hợp hàm Proper và hàm Trim nên thấy hơi dài dòng, nhưng lại hiệu quả.
Các bạn tham khảo:
PHP:
Function MyUniProper(MyTextUni As String) As String
Dim MyChar As String, MyProper As String, LenChar As Long, Tmp As String
MyTextUni = " " & LCase(MyTextUni)
For LenChar = 2 To Len(MyTextUni)
MyChar = Mid(MyTextUni, LenChar, 1)
If Mid(MyTextUni, LenChar - 1, 1) = " " Then
If AscW(MyChar) < 256 Then MyChar = UCase(MyChar) Else MyChar = ChrW(AscW(MyChar) - 1)
End If
MyProper = MyProper & MyChar
Next
Tmp = Trim(MyProper)
Do While InStr(Tmp, Space(2))
Tmp = Replace(Tmp, Space(2), Space(1))
Loop
MyUniProper = Tmp
End Function
Thật ra 3 hàm UPPER, LOWER và PROPER không đơn giản thế đâu
Thí nghiệm 3 hàm này trên Excel sẽ thấy nó làm việc được với Range và cả Array nữa đấy
Nếu xây dựng hàm làm việc với Uniode, hãy viết theo hướng này... Ví dụ:
PHP:
Private Function ChangeCaseFromString(ByVal Text As String, ByVal CaseType As Long) As String
Dim Arr, i As Long
On Error Resume Next
If Trim(Text) <> "" And Not (IsNumeric(Text)) Then
Select Case CaseType
Case 1: ChangeCaseFromString = LCase(Text)
Case 2: ChangeCaseFromString = UCase(Text)
Case 3
If InStr(Trim(Text), " ") Then
Arr = Split(Text, " ")
For i = 0 To UBound(Arr)
If Trim(Arr(i)) <> "" Then _
Arr(i) = UCase(Left(Trim(Arr(i)), 1)) & LCase(Mid(Trim(Arr(i)), 2, Len(Arr(i))))
Next
ChangeCaseFromString = Join(Arr, " ")
Else
ChangeCaseFromString = UCase(Left(Trim(Text), 1)) & LCase(Mid(Trim(Text), 2, Len(Text)))
End If
End Select
Else
ChangeCaseFromString = Text
End If
End Function
PHP:
Function ChangeCase(ByVal sArray, ByVal CaseType As Long)
Dim TmpArr, TmpStr As String, i As Long, j As Long
On Error Resume Next
TmpArr = sArray
If TypeName(TmpArr) <> "Variant()" Then
TmpArr = ChangeCaseFromString(TmpArr, CaseType)
Else
TmpStr = Join(TmpArr, " ")
If TmpStr <> "" Then
For i = LBound(TmpArr) To UBound(TmpArr)
TmpArr(i) = ChangeCaseFromString(TmpArr(i), CaseType)
Next
Else
For i = LBound(TmpArr, 1) To UBound(TmpArr, 1)
For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
TmpArr(i, j) = ChangeCaseFromString(TmpArr(i, j), CaseType)
Next
Next
End If
End If
ChangeCase = TmpArr
End Function
Trong đó hàm ChangeCaseFromString là hàm hổ trợ và ChangeCase là hàm chính
Áp dụng: =ChangeCase(A1:A4,3) ---> Proper cho vùng A1:A4 =ChangeCase({"cộng hòa","chủ nghĩa";"xã hội","việt nam"},3) ---> Proper cho 1 Array
vân vân...
------------------
Có thể áp dụng hàm trên để ChangeCase dữ liệu trên ListBox của UserForm chẳng hạn
Vậy đó, nhưng PROPER trong Excel nó hiểu hết đó! Vậy làm theo hàm này ngắn gọn vậy!
Mã:
Function PCase(MyTextUni As String) As String
Dim stt As Long
MyTextUni = " " & MyTrim(LCase(MyTextUni))
stt = Len(MyTextUni)
If stt > 1 Then
Do
stt = InStrRev(MyTextUni, " ", stt)
Mid(MyTextUni, stt + 1, 1) = UCase(Mid(MyTextUni, stt + 1, 1))
stt = stt - 1
Loop While stt > 0
[COLOR=#ff0000][B]PCase = WorksheetFunction.Proper(Mid(MyTextUni, 2))[/B][/COLOR]
End If
End Function
Vậy đó, nhưng PROPER trong Excel nó hiểu hết đó! Vậy làm theo hàm này ngắn gọn vậy!
Mã:
Function PCase(MyTextUni As String) As String
Dim stt As Long
MyTextUni = " " & MyTrim(LCase(MyTextUni))
stt = Len(MyTextUni)
If stt > 1 Then
Do
stt = InStrRev(MyTextUni, " ", stt)
Mid(MyTextUni, stt + 1, 1) = UCase(Mid(MyTextUni, stt + 1, 1))
stt = stt - 1
Loop While stt > 0
[COLOR=#ff0000][B]PCase = WorksheetFunction.Proper(Mid(MyTextUni, 2))[/B][/COLOR]
End If
End Function
Bạn có thể sửa code sau cho nó dùng được với dấu chấm... chứ dùng PROPER thì cũng như không... Nó đâu có chính xác với chuổi tiếng Việt Unicode
Trong code của bạn có thằng MyTrim(LCase(MyTextUni))... chẳng hiểu MyTrim là giống gì
Bạn có thể sửa code sau cho nó dùng được với dấu chấm... chứ dùng PROPER thì cũng như không... Nó đâu có chính xác với chuổi tiếng Việt Unicode
Trong code của bạn có thằng MyTrim(LCase(MyTextUni))... chẳng hiểu MyTrim là giống gì
Sorry, cái đó do dùng Replace nên bị "dính chưởng" luôn, phải như vầy: Trim(LCase(MyTextUni))
Mã:
[/B]Function PCase(MyTextUni As String) As String
Dim stt As Long
MyTextUni = " " & Trim(LCase(MyTextUni))
stt = Len(MyTextUni)
If stt > 1 Then
Do
stt = InStrRev(MyTextUni, " ", stt)
Mid(MyTextUni, stt + 1, 1) = UCase(Mid(MyTextUni, stt + 1, 1))
stt = stt - 1
Loop While stt > 0
PCase = WorksheetFunction.Proper(Mid(MyTextUni, 2))
End If
End Function
[B]
Với hàm này bảo đảm không bị sót chữ đâu Thầy ơi, em thử mọi trường hợp về dấu rồi mà! Nhưng nếu dùng không PROPER trong sheet thì bị lỗi nhiều đấy!
Hàm proper xài tốt cho Unicode tiếng Anh. (Ẹc ẹc, mở bài thôi)
Unicode tiếng Việt chỉ có rất ít ký tự có dấu đứng đầu 1 từ: Ú, Ứ, Ấ, Ẩ, Ă, Ê, Ế, ... (ký tự sau không quan tâm (ẹc ẹc, dẫn đề đó)
Vậy, chỉ cần dùng Proper của Excel + 1 mảng 2 chiều, + 1 vòng lặp Replace từ đầu mảng đến cuối mảng là xong.
Cũng như đọc số thành chữ Unicode, đâu cần thay hết 6, 7 chục ký tự có dấu tiếng Việt đâu? Chỉ thay 1 số ký tự xài trong các từ đọc số thôi. (Cái này là thân bài)
Chưa thấy trường hợp nào viết tắt có dấu ở nguyên âm. Vậy trường hợp này đương nhiên bị loại trừ, nhưng ví dụ như đường Phan Đình Phùng, viết tắt p.đ.p nó hiểu ngay là P.Đ.P
Chưa thấy trường hợp nào viết tắt có dấu ở nguyên âm. Vậy trường hợp này đương nhiên bị loại trừ, nhưng ví dụ như đường Phan Đình Phùng, viết tắt p.đ.p nó hiểu ngay là P.Đ.P
Chưa thấy không có nghĩa là không có
Hàm thì phải tổng quát chứ
Ẹc... Ẹc... Sửa lại đi đồng chí ơi
Nói thiệt, hàm tôi viết ở trên, nếu muốn chơi thêm dấu chấm cũng chỉ sửa cái rẹt là xong!
Tóm lại: Chơi với PROPER là.. THUA
Chưa thấy không có nghĩa là không có
Hàm thì phải tổng quát chứ
Ẹc... Ẹc... Sửa lại đi đồng chí ơi
Nói thiệt, hàm tôi viết ở trên, nếu muốn chơi thêm dấu chấm cũng chỉ sửa cái rẹt là xong!
Tóm lại: Chơi với PROPER là.. THUA
Không đâu Thầy ơi, với dấu đặc biệt như gạch ngang (-) gạch nối (_), dấu sao (*), dấu xuyệt/xẹt (/) ... thì nó phân biệt được hết chứ không riêng gì dấu chấm (.)
Không đâu Thầy ơi, với dấu đặc biệt như gạch ngang (-) gạch nối (_), dấu sao (*), dấu xuyệt/xẹt (/) ... thì nó phân biệt được hết chứ không riêng gì dấu chấm (.)
Để ý sẽ thấy rằng: Toàn bộ các ký tự đặc biệt đều có đặc điểm LCase("Ký tự đặc biệt") = UCase("Ký tự đặc biệt")
Vậy thì theo thuật toán này mà làm... ví dụ thế này:
PHP:
tmp = Trim(Text)
If Len(tmp) = 1 Then
ChangeCaseFromString = UCase(tmp)
Else
tmp = UCase(Left(tmp, 1)) & LCase(Mid(tmp, 2, Len(tmp)))
For i = 2 To Len(tmp)
If UCase(Mid(tmp, i, 1)) <> LCase(Mid(tmp, i, 1)) Then
If UCase(Mid(tmp, i - 1, 1)) = LCase(Mid(tmp, i - 1, 1)) Then
tmp = Left(tmp, i - 1) & Replace(tmp, Mid(tmp, i, 1), UCase(Mid(tmp, i, 1)), i, 1)
End If
End If
Next
ChangeCaseFromString = tmp
End If
Để ý sẽ thấy rằng: Toàn bộ các ký tự đặc biệt đều có đặc điểm LCase("Ký tự đặc biệt") = UCase("Ký tự đặc biệt")
Vậy thì theo thuật toán này mà làm... ví dụ thế này:
PHP:
tmp = Trim(Text)
If Len(tmp) = 1 Then
ChangeCaseFromString = UCase(tmp)
Else
tmp = UCase(Left(tmp, 1)) & LCase(Mid(tmp, 2, Len(tmp)))
For i = 2 To Len(tmp)
If UCase(Mid(tmp, i, 1)) <> LCase(Mid(tmp, i, 1)) Then
If UCase(Mid(tmp, i - 1, 1)) = LCase(Mid(tmp, i - 1, 1)) Then
tmp = Left(tmp, i - 1) & Replace(tmp, Mid(tmp, i, 1), UCase(Mid(tmp, i, 1)), i, 1)
End If
End If
Next
ChangeCaseFromString = tmp
End If
Tuyệt vời quá, đã kiểm tra và thật như ý! Cám ơn Thầy nhiều! Cho em cập nhật mới hàm ChangeCaseFromString của Thầy nhé:
Hàm bổ trợ:
Mã:
Private Function ChangeCaseFromString(ByVal Text As String, ByVal CaseType As Long) As String
Dim Arr, i As Long
On Error Resume Next
If Trim(Text) <> "" And Not (IsNumeric(Text)) Then
Select Case CaseType
Case 1: ChangeCaseFromString = LCase(Text)
Case 2: ChangeCaseFromString = UCase(Text)
Case 3
tmp = Trim(Text)
If Len(tmp) = 1 Then
ChangeCaseFromString = UCase(tmp)
Else
tmp = UCase(Left(tmp, 1)) & LCase(Mid(tmp, 2, Len(tmp)))
For i = 2 To Len(tmp)
If UCase(Mid(tmp, i, 1)) <> LCase(Mid(tmp, i, 1)) Then
If UCase(Mid(tmp, i - 1, 1)) = LCase(Mid(tmp, i - 1, 1)) Then
tmp = Left(tmp, i - 1) & Replace(tmp, Mid(tmp, i, 1), UCase(Mid(tmp, i, 1)), i, 1)
End If
End If
Next
ChangeCaseFromString = tmp
End If
End Select
End If
End Function
Hàm sử dụng (không đổi):
Mã:
Function ChangeCase(ByVal sArray, ByVal CaseType As Long)
Dim TmpArr, TmpStr As String, i As Long, j As Long
On Error Resume Next
TmpArr = sArray
If TypeName(TmpArr) <> "Variant()" Then
TmpArr = ChangeCaseFromString(TmpArr, CaseType)
Else
TmpStr = Join(TmpArr, " ")
If TmpStr <> "" Then
For i = LBound(TmpArr) To UBound(TmpArr)
TmpArr(i) = ChangeCaseFromString(TmpArr(i), CaseType)
Next
Else
For i = LBound(TmpArr, 1) To UBound(TmpArr, 1)
For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
TmpArr(i, j) = ChangeCaseFromString(TmpArr(i, j), CaseType)
Next
Next
End If
End If
ChangeCase = TmpArr
End Function
Trong đó hàm ChangeCaseFromString là hàm hổ trợ và ChangeCase là hàm chính
Áp dụng:
=ChangeCase(A1:A4,3) ---> Proper cho vùng A1:A4
=ChangeCase({"cộng hòa","chủ nghĩa";"xã hội","việt nam"},3) ---> Proper cho 1 Array
vân vân...
------------------
Có thể áp dụng hàm trên để ChangeCase dữ liệu trên ListBox của UserForm chẳng hạn
Tuyệt vời quá, đã kiểm tra và thật như ý! Cám ơn Thầy nhiều! Cho em cập nhật mới hàm ChangeCaseFromString của Thầy nhé:
Hàm bổ trợ:
Mã:
Private Function ChangeCaseFromString(ByVal Text As String, ByVal CaseType As Long) As String
Dim Arr, i As Long
On Error Resume Next
If Trim(Text) <> "" And Not (IsNumeric(Text)) Then
Select Case CaseType
Case 1: ChangeCaseFromString = LCase(Text)
Case 2: ChangeCaseFromString = UCase(Text)
Case 3
tmp = Trim(Text)
If Len(tmp) = 1 Then
ChangeCaseFromString = UCase(tmp)
Else
tmp = UCase(Left(tmp, 1)) & LCase(Mid(tmp, 2, Len(tmp)))
For i = 2 To Len(tmp)
If UCase(Mid(tmp, i, 1)) <> LCase(Mid(tmp, i, 1)) Then
If UCase(Mid(tmp, i - 1, 1)) = LCase(Mid(tmp, i - 1, 1)) Then
tmp = Left(tmp, i - 1) & Replace(tmp, Mid(tmp, i, 1), UCase(Mid(tmp, i, 1)), i, 1)
End If
End If
Next
ChangeCaseFromString = tmp
End If
End Select
End If
End Function
Buồn buồn ngồi Test thử hàm trên (kiểu PROPER) và ngẫm nghĩ lại, thấy thời gian của hàm này ... chậm quá!
Tôi test như sau:
Tạo một biến kiểu chuỗi toàn cục, viết thủ tục để tạo dãy chuỗi ký tự cho biến đó:
Tại Module1 đặt hàm ChangeCaseFromString trên vào trong.
Tại Module2 đặt thủ tục test:
Mã:
[COLOR=#0000ff]''Dòng đầu tiên:[/COLOR]
Public Str As String
[COLOR=#0000ff]''Code tạo chuỗi ([/COLOR][COLOR=#ff0000]chỉ cho chạy 1 lần[/COLOR][COLOR=#0000ff]):[/COLOR]
Sub CreateString()
Dim i As Long
Str = ""
For i = 1 To 5000
Str = Str + "hoang trong.n.g.h.i.a ng......hi.......a..... "
Next
End Sub
[COLOR=#0000ff]''Code test thời gian:[/COLOR]
Sub Test_Old_Version()
Dim t As Double
t = Timer
Dim Text As String
Text = ChangeCaseFromString(Str, 3)
Debug.Print "2/ " & Timer - t
End Sub
Kết quả thời gian xử lý cho chuỗi đó trên máy tôi: 88.2890625 giây!
Bây giờ tôi sẽ cải tiến hàm đó bằng cách xử lý chuỗi theo cách tách ký tự của chuỗi đầu vào ra từng ký tự, gán các ký tự được tách này vào một mảng một chiều, sau đó xử lý mỗi phần tử của mảng này:
Hàm đã được cải tiến: ChangeCaseFromString_HTN
Tôi đặt hàm này vào Module1:
[GPECODE=vb]
Public Enum CaseType
Lower = 1
Upper = 2
Proper = 3
End Enum
''NEW VERSION:
Function ChangeCaseFromString_HTN(ByVal UnicodeString As String, Optional ByVal CaseOfType As CaseType) As String
If UnicodeString = "" Then Exit Function
Select Case CaseOfType
Case 1 'LOWER:
ChangeCaseFromString_HTN = LCase(UnicodeString)
Case 2 'UPPER:
ChangeCaseFromString_HTN = UCase(UnicodeString)
Case 3 'PROPER:
Dim ArrChar(), i As Long
UnicodeString = UCase(UnicodeString)
ReDim ArrChar(1 To Len(UnicodeString))
ArrChar(1) = Left(UnicodeString, 1)
For i = 2 To Len(UnicodeString)
ArrChar(i) = Mid(UnicodeString, i, 1)
If UCase(ArrChar(i - 1)) <> LCase(ArrChar(i - 1)) Then
ArrChar(i) = LCase(ArrChar(i))
End If
Next
ChangeCaseFromString_HTN = Join(ArrChar, "")
Case Else 'Return input string:
ChangeCaseFromString_HTN = UnicodeString
End Select
End Function
[/GPECODE]
Và đặt thủ tục test vào Module2:
Mã:
Sub Test_New_Version()
Dim t As Double
t = Timer
Dim Text As String
Text = ChangeCaseFromString_HTN(Str, Proper)
Debug.Print "1/ " & Timer - t
End Sub
Kết quả của hàm cải tiến có thời gian xử lý là: 1.089075 giây!
