Cát Lượng
Thành viên tiêu biểu
- Tham gia
- 14/11/18
- Bài viết
- 403
- Được thích
- 66
Em chào các thầy, các anh/chị
Em xin được nhờ các thầy, anh/chị giúp em sửa đoạn code chuyển ký tự in thường thành ký tự in hoa ở vị trí đầu tiên của mỗi ô trong excel.
Em có sử dụng đoạn code:
Khi chạy code để chuyển ký tự thường thành ký tự in hoa đầu mỗi ô thì các ký tự in hoa phía sau lại bị chuyển thành ký tự thường như trong hình dưới.
Em nhờ sửa giúp em đoạn code để khi chạy code chỉ có các ký tự đầu ô chuyển thành ký tự in hoa, còn các ký tự phía sau không bị tác động
Em xin được nhờ các thầy, anh/chị giúp em sửa đoạn code chuyển ký tự in thường thành ký tự in hoa ở vị trí đầu tiên của mỗi ô trong excel.
Em có sử dụng đoạn code:
Mã:
Public Function USD(AMT)
Dim ToRead, Chuoi, Nhom, Word As String
Dim I, J As Byte, W, X, Y, Z As Double
Dim Donvi, HChuc, Khung
If AMT = 0 Then
ToRead = "Nought" & Space(1) & "USD"
Else
Donvi = Array("None", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen")
HChuc = Array("None", "None", "twenty", "thirty", "fourty", "fifty", "sixty", "seventy", "eighty", "ninety")
Khung = Array("None", "trillion", "billion", "million", "thousand", "USD", "cents")
If AMT < 0 Then
ToRead = "Minus" & Space(1)
Else
ToRead = Space(0)
End If
Chuoi = Format(Abs(AMT), "###############.00")
Chuoi = Right(Space(15) & Chuoi, 18)
For I = 1 To 6
Nhom = Mid(Chuoi, I * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If I = 5 And Abs(AMT) > 1 Then
Word = "USD" & Space(1)
Else
Word = Space(0)
End If
Case ".00"
Word = "only"
Case Else
X = Val(Left(Nhom, 1))
Y = Val(Mid(Nhom, 2, 1))
Z = Val(Right(Nhom, 1))
W = Val(Right(Nhom, 2))
If X = 0 Then
Word = Space(0)
Else
Word = Donvi(X) & Space(1) & "hundred" & Space(1)
If W > 0 And W < 21 Then
Word = Word & "and" & Space(1)
End If
End If
If I = 6 And Abs(AMT) > 1 Then
Word = "and" & Space(1) & Word
End If
If W < 20 And W > 0 Then
Word = Word & Donvi(W) & Space(1)
Else
If W >= 20 Then
Word = Word & HChuc(Y) & Space(1)
If Z > 0 Then
Word = Word & Donvi(Z) & Space(1)
End If
End If
End If
Word = Word & Khung(I) & Space(1)
End Select
ToRead = ToRead & Word
End If
Next I
End If
USD = UCase(Left(ToRead, 1)) & Mid(ToRead, 2)
End Function
Function VND(baonhieu)
'Tien Viet tieng Viet Font Unicode
Dim KetQua, SoTien, Nhom, Chu, Dich, S1, S2, S3 As String
Dim I, J, ViTri As Byte, S As Double
Dim Hang, Doc, Dem
If Trim(baonhieu) = "" Then
VND = ""
Exit Function
ElseIf baonhieu = 0 Then
VND = "kh" & ChrW(244) & "ng"
Exit Function
ElseIf IsDate(baonhieu) Then
ngay = Day(baonhieu)
Thang = Month(baonhieu)
Nam = Year(baonhieu)
VND = "ng" & ChrW(224) & "y " & ngay & " th" & ChrW(225) & "ng " & Thang & " n" & ChrW(462) & "m " & Nam
Exit Function
ElseIf IsNumeric(baonhieu) = True Then
'---------------------------------------------------------------------------------------------------------------------------------
'If baonhieu = 0 Then
'KetQua = "Kh" & ChrW$(244) & "ng " & ChrW$(273) & ChrW$(7891) & "ng"
'Else
'---------------------------------------------------------------------------------------------------------------------------------
If Abs(baonhieu) >= 1E+15 Then
KetQua = "S" & ChrW$(7889) & " qu" & ChrW$(225) & " l" & ChrW$(7899) & "n - H" & ChrW$(224) & "m " & ChrW$(273) & ChrW$(7893) & "i s" & ChrW$(7889) & " ra ch" & ChrW$(7919) & " Vi" & ChrW$(7879) & "t Nam; font ch" & ChrW$(7919) & " Tahoma - Copyright by VoTuanKiet of AMG (0938 73 73 93)"
Else
If baonhieu < 0 Then
KetQua = ChrW$(194) & "m" & Space(1)
Else
KetQua = Space(0)
End If
SoTien = Format(Abs(baonhieu), "##############0.00")
SoTien = Right(Space(15) & SoTien, 18)
Hang = Array("None", "tr" & ChrW$(259) & "m", "m" & ChrW$(432) & ChrW$(417) & "i", "g" & ChrW$(236) & " " & ChrW$(273) & "ã")
Doc = Array("None", "ng" & ChrW$(224) & "n t" & ChrW$(7927), "t" & ChrW$(7927), "tri" & ChrW$(7879) & "u", "ng" & ChrW$(224) & "n", ChrW$(273) & ChrW$(7891) & "ng", "")
Dem = Array("None", "m" & ChrW$(7897) & "t", "hai", "ba", "b" & ChrW$(7889) & "n", "n" & ChrW$(259) & "m", "s" & ChrW$(225) & "u", "b" & ChrW$(7849) & "y", "t" & ChrW$(225) & "m", "ch" & ChrW$(237) & "n")
For I = 1 To 6
Nhom = Mid(SoTien, I * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If I = 5 Then
Chu = ChrW$(273) & ChrW$(7891) & "ng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "ch" & ChrW$(7861) & "n"
Case Else
S1 = Left(Nhom, 1)
S2 = Mid(Nhom, 2, 1)
S3 = Right(Nhom, 1)
Chu = Space(0)
Hang(3) = Doc(I)
For J = 1 To 3
Dich = Space(0)
S = Val(Mid(Nhom, J, 1))
If S > 0 Then
Dich = Dem(S) & Space(1) & Hang(J) & Space(1)
End If
Select Case J
Case 2 And S = 1
Dich = "m" & ChrW$(432) & ChrW$(7901) & "i" & Space(1)
Case 3 And S = 0 And Nhom <> Space(2) & "0"
Dich = Hang(J) & Space(1)
Case 3 And S = 5 And S2 <> Space(1) And S2 <> "0"
Dich = "l" & Mid(Dich, 2)
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 4) Then
Dich = "l" & ChrW$(7867) & Space(1)
End If
End Select
Chu = Chu & Dich
Next J
End Select
ViTri = InStr(1, Chu, "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7897) & "t", 1)
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7889) & "t"
KetQua = KetQua & Chu
End If
Next I
End If
End If
VND = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Function LowerUni(Chuoi As String) As String
LowerUni = Application.WorksheetFunction.Trim(LCase(Chuoi))
End Function
Function ProperUni(Chuoi As String) As String
Chuoi = " " & Application.WorksheetFunction.Trim(LCase(Chuoi))
stt = Len(Chuoi)
If stt > 1 Then
Do
stt = InStrRev(Chuoi, " ", stt)
Mid(Chuoi, stt + 1, 1) = UCase(Mid(Chuoi, stt + 1, 1))
stt = stt - 1
Loop While stt > 0
ProperUni = Mid(Chuoi, 2)
End If
End Function
Function UpperUni(Chuoi As String) As String
UpperUni = Application.WorksheetFunction.Trim(UCase(Chuoi))
End Function
Sub ChuHoaDauDong()
For Each clls In Selection
If clls.HasFormula = False Then
clls.Value = UpperUni(Left(clls.Text, 1)) & LowerUni(Right(clls.Text, Len(clls.Text) - 1))
End If
Next clls
End SubEm nhờ sửa giúp em đoạn code để khi chạy code chỉ có các ký tự đầu ô chuyển thành ký tự in hoa, còn các ký tự phía sau không bị tác động
