Nhờ sửa giúp code chuyển ký tự thường thành in hoa

Liên hệ QC
Cát Lượng

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:
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 Sub
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 động111.png
 
Cát Lượng đã viết:
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:
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 Sub
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 độngView attachment 221169
Nhấp chuột vào đây để mở rộng...
Có thể dùng hàm có sẵn
Mã: 
=PROPER(LEFT(A1))&LOWER(MID(A1,2,LEN(A1)))
 

File đính kèm

  • CHUYENDOI.xlsx
    9.4 KB · Đọc: 10
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

T
[Giúp đỡ] Tìm số lượng nhân viên đã tham gia làm lô hàng
Trả lời
10
Đọc
103
Hoàng Tuấn 868
H
8
Hàm thống kê số lượng thành viên câu lạc bộ theo từng đợt tuyển thành viên
Trả lời
3
Đọc
75
HieuCD
H
LuuAnh980
Sao Filter của Excel kỳ lạ.
Trả lời
9
Đọc
62
Hoàng Tuấn 868
H
H
  • Question
nhờ các bác viết mẫu cho em lệnh dùng checkbox để rút ngắn thời gian thao tác
Trả lời
10
Đọc
191
hiv174
H
hoang.buivan93
Gặp rắc rối về phần công thức hàm tìm kiếm dữ liệu. Nhờ mọi người chỉ giáo giúp ạ.
Trả lời
3
Đọc
62
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom