Tự động đổi chữ thường ra chữ hoa sau khi nhập liệu (1 người xem)

[jackylai]

Dear all,
Mình có một vấn đề rất mong anh chị em trong diễn đàn giúp đỡ:
Mình có một range (vd: A1:A10) trong Sheet1 và muốn mỗi lần nhập liệu vào bất kỳ cell nào trong range này dữ liệu sẽ tự động được chuyển từ chữ thường sang chữ in hoa.Rất mong nhận được sự giúp đỡ.
(Đã dùng hướng dẫn trong thread này: http://www.giaiphapexcel.com/forum/showthread.php?3239 nhưng không có tác dụng)

 

[Quang_Hải]

Bạn chèn code này vào sheet là ok, lưu ý chỉ tác dụng trên cột A thôi nhé

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
    ActiveCell.Offset(-1) = UCase(ActiveCell.Offset(-1))
End If
End Sub

 

[Hong.Van]

Bạn chèn code này vào sheet là ok, lưu ý chỉ tác dụng trên cột A thôi nhé

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
    ActiveCell.Offset(-1) = UCase(ActiveCell.Offset(-1))
End If
End Sub

Bạn Jackylai@ chỉ muốn có tác dụng chuyển thành chữ hoa từ A1:A10 thôi mà thầy! như vậy code phải sửa ntn? Em cảm ơn

 

[Quang_Hải]

Hic,, không đưa file cứ bắt người khác tưởng tượng hoài. Cái excel có sẵn hàm UPPER không chịu xài. Nếu muốn làm bằng VBA thì up file lên nhé

 

[jackylai]

IfNếu dùng hàm UPPER thì phải đặt công thức ở cột khác, trong khi ý em muốn nhập xong nó tự chuyển luôn. Nếu muốn áp dùng cho range, code có thể sửa như sau được không ạ: "If Target = Range ("A1:A10")"?

 

[Quang_Hải]

Đơn giản mà


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row <= 10 Then
If Target.Column = 1 Then
ActiveCell.Offset(-1) = UCase(ActiveCell.Offset(-1))
End If
End If
End Sub

 

[Hong.Van]

IfNếu dùng hàm UPPER thì phải đặt công thức ở cột khác, trong khi ý em muốn nhập xong nó tự chuyển luôn. Nếu muốn áp dùng cho range, code có thể sửa như sau được không ạ: "If Target = Range ("A1:A10")"?

Code sửa lại như thế này

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
        Target.Value = UCase(Target.Value)
End If
End Sub

 

[Hai Lúa Miền Tây]

Code sửa lại như thế này

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
        Target.Value = UCase(Target.Value)
End If
End Sub

Đối với công thức thì nên bỏ qua không chuyển.

 

[Quang_Hải]

Vậy làm cho tới nơi luôn là thế này chắc là được

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
    If Not Target.HasFormula Then Target = UCase(Target)
End If
End Sub

 

[Hai Lúa Miền Tây]

Vậy làm cho tới nơi luôn là thế này chắc là được

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
    If Not Target.HasFormula Then Target = UCase(Target)
End If
End Sub

Fill xuống vẫn còn bị lỗi nha bạn.

 

[Quang_Hải]

Fill xuống vẫn còn bị lỗi nha bạn.

Chưa hiểu, anh sửa lại cho hoàn chỉnh luôn đi.

 

[Hai Lúa Miền Tây]

Chưa hiểu, anh sửa lại cho hoàn chỉnh luôn đi.

Bạn cứ thử A1 nhập 1, A2 nhập 2, 2 cell đó fill xuống để ra số thứ tự. Xử lý lỗi bạn dư biết mà phải hôn.

 

[Hong.Van]

Bạn cứ thử A1 nhập 1, A2 nhập 2, 2 cell đó fill xuống để ra số thứ tự. Xử lý lỗi bạn dư biết mà phải hôn.

Em thì xử lý như thế này luôn, thêm dòng code này vào

On Error Resume Next

Như vậy có Insert dòng cũng không bị báo lỗi!

 

[Quang_Hải]

Bạn cứ thử A1 nhập 1, A2 nhập 2, 2 cell đó fill xuống để ra số thứ tự. Xử lý lỗi bạn dư biết mà phải hôn.

À thì ra là thế, vậy mà mình cứ tưởng bạn đề cập vân đề gì. Mình cứ nghĩ là tác giả sẽ nhập nôi dung gi đó trong khu vực này, dễ gì đem cái vùng này ra mà điền số thứ tự chứ. Vậy phí code quá còn gì, hì hì.

 

[hcl_pt]

Vậy làm cho tới nơi luôn là thế này chắc là được

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
    If Not Target.HasFormula Then Target = UCase(Target)
End If
End Sub

Thầy Hải ơi, cho em hỏi code này muốn sửa lại chỉ viết Hoa chữ cái đầu tiên thì sửa như thế nào ạ? ví dụ: Nguyễn Văn An

 

[Hoàng Tuấn 868]

Thầy Hải ơi, cho em hỏi code này muốn sửa lại chỉ viết Hoa chữ cái đầu tiên thì sửa như thế nào ạ? ví dụ: Nguyễn Văn An

Bạn thử tìm hiểu hàm PROPER xem sao.

 

[hcl_pt]

Bạn thử tìm hiểu hàm PROPER xem sao.

Cảm ơn thầy Tuấn- Em muốn sử dụng VBA như của thầy Hải nhưng thay cho việc chuyển đổi toàn bộ thành chữ in hoa thì em chỉ viết Hoa chữ cái đầu tiên ạ!

 

[Hoàng Tuấn 868]

chỉ viết Hoa chữ cái đầu tiên ạ!

Bạn cho ví dụ đầu vào và đầu ra xem thế nào?

 

[ongke0711]

Cảm ơn thầy Tuấn- Em muốn sử dụng VBA như của thầy Hải nhưng thay cho việc chuyển đổi toàn bộ thành chữ in hoa thì em chỉ viết Hoa chữ cái đầu tiên ạ!

Bạn dùng hàm này thử đi nhé. Hàm sẽ bỏ các khoảng trắng dư thừa giữa 2 từ và viết hoa ký tự đầu.

Public Function QuyChuanHoTen(HoTen As String) As String
    Dim i As Long, TG As String, Ok As Boolean, s As String
    HoTen = Strings.Trim(HoTen)
    s = Strings.LCase$(HoTen)
    TG = ""
    Ok = True
    For i = 1 To Strings.Len(s)
        If Strings.Mid(s, i, 1) <> " " Then
            If Ok = True Then
                TG = TG + Strings.UCase$(Strings.Mid(s, i, 1))
                Ok = False
            Else
                TG = TG + Strings.Mid(s, i, 1)
            End If
        Else
            Ok = True
            If Strings.Mid(s, i + 1, 1) <> " " Then
                TG = TG + " "
            End If
        End If
    Next
    QuyChuanHoTen = Strings.Trim(TG)
End Function

 

[hcl_pt]

Bạn dùng hàm này thử đi nhé. Hàm sẽ bỏ các khoảng trắng dư thừa giữa 2 từ và viết hoa ký tự đầu.

Public Function QuyChuanHoTen(HoTen As String) As String
    Dim i As Long, TG As String, Ok As Boolean, s As String
    HoTen = Strings.Trim(HoTen)
    s = Strings.LCase$(HoTen)
    TG = ""
    Ok = True
    For i = 1 To Strings.Len(s)
        If Strings.Mid(s, i, 1) <> " " Then
            If Ok = True Then
                TG = TG + Strings.UCase$(Strings.Mid(s, i, 1))
                Ok = False
            Else
                TG = TG + Strings.Mid(s, i, 1)
            End If
        Else
            Ok = True
            If Strings.Mid(s, i + 1, 1) <> " " Then
                TG = TG + " "
            End If
        End If
    Next
    QuyChuanHoTen = Strings.Trim(TG)
End Function

dạ, Thầy cho em hỏi sử dụng hàm này như thế nào ạ? Em muốn sử dụng cho việc nhập họ tên ở cột C từ ô C5:C250 trong sheet1 ạ?

 

[ongke0711]

dạ, Thầy cho em hỏi sử dụng hàm này như thế nào ạ? Em muốn sử dụng cho việc nhập họ tên ở cột C từ ô C5:C250 trong sheet1 ạ?

Đừng gọi Thầy, gọi anh cũng được rồi (cho thấy trẻ).
Ý bạn là muốn nhập xong thì nó tự chỉnh sửa hay trình tự thao tác như thế nào?

 

[hcl_pt]

Đừng gọi Thầy, gọi anh cũng được rồi (cho thấy trẻ).
Ý bạn là muốn nhập xong thì nó tự chỉnh sửa hay trình tự thao tác như thế nào?

Cảm ơn anh! Ý là nhập xong thì nó tự chỉnh sửa ạ!

 

[Hoàng Tuấn 868]

nhập xong thì nó tự chỉnh sửa ạ!

Bạn xem thử, không biết đúng ý chưa?

 

[ongke0711]

Bạn xem thử, không biết đúng ý chưa?

Không biết Office tôi có lỗi hay không chứ tôi chạy thử trên Office 2013 (32bit) và Office 365 (64) đều bị treo và thoát Excel sau nhập liệu và bấm Enter.

 

[Hoàng Tuấn 868]

Không biết Office tôi có lỗi hay không chứ tôi chạy thử trên Office 2013 (32bit) và Office 365 (64) đều bị treo và thoát Excel sau nhập liệu và bấm Enter.

Em dùng Office 2021 (32bit), chạy bình thường không thấy bị sao mới dám gửi lên anh ạ.

 

[hcl_pt]

Xin cảm ơn các thầy đã giúp đỡ! Em mày mò chắp vá cũng ra được cái này rồi ạ!

 

[Hoàng Tuấn 868]

Xin cảm ơn các thầy đã giúp đỡ! Em mày mò chắp vá cũng ra được cái này rồi ạ!

Không nên gọi là thầy nhé.
Code của bạn vòng vèo quá, nhưng chạy được là tốt rồi, file của mình trên máy tính bạn chạy có vấn đề gì giống như của ongke0711 không?
File của bạn nên tạo Userform nhập liệu sẽ nhanh và chính xác hơn nhiều.

 

[ongke0711]

Em dùng Office 2021 (32bit), chạy bình thường không thấy bị sao mới dám gửi lên anh ạ.

Máy tôi nó phản ứng lạ quá. Win11 + O365 bản quyền.
Sự kiện trong Sheet Excel không rành nên khó bắt sự kiện AfterUpdate và OnExit như trên Form.
Code này của tôi phải bấm quay ngược lại cái Cell vừa gõ nó mới cập nhật.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim oldCellText As String
    Dim intersectRange As Range
    Dim lastRow As Long
    Const targetCol As String = "C"
    Const startRow As Long = 2
    
    lastRow = Cells(Rows.Count, targetCol).End(xlUp).Row
    Set intersectRange = Range(targetCol & startRow & ":" & targetCol & lastRow + 1)
    
    If Not Intersect(Target, intersectRange) Is Nothing Then
        On Error Resume Next
        oldCellText = Target.Value
        Target.Value = QuyChuanHoTen(oldCellText)
    End If
    
End Sub

Lỗi khi sử dụng file của bạn Tuấn 686:

 

[Hoàng Tuấn 868]

Máy tôi nó phản ứng lạ quá. Win11 + O365 bản quyền.

Em chạy Win10, không hiểu sao bên máy anh lại như vậy. Code em viết cũng bình thường.

 

[hcl_pt]

Không nên gọi là thầy nhé.
Code của bạn vòng vèo quá, nhưng chạy được là tốt rồi, file của mình trên máy tính bạn chạy có vấn đề gì giống như của ongke0711 không?
File của bạn nên tạo Userform nhập liệu sẽ nhanh và chính xác hơn nhiều.

dạ, file của anh em chạy trên máy em chạy ok ạ nhưng không xóa khoảng trắng từ 2 khoảng trắng trở lên ạ

 

[Hoàng Tuấn 868]

dạ, file của anh em chạy trên máy em chạy ok ạ nhưng không xóa khoảng trắng từ 2 khoảng trắng trở lên ạ

Thêm phần xóa khoảng trắng thừa.

 

[ongke0711]

Nhìn bài bạn Tuấn 868 mới ngộ ra cách dùng ActiveCell....

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim oldCellText As String
    Dim intersectRange As Range
    Dim lastRow As Long
    Const targetCol As String = "C"
    Const startRow As Long = 2
    
    lastRow = Cells(Rows.Count, targetCol).End(xlUp).Row
    Set intersectRange = Range(targetCol & startRow & ":" & targetCol & lastRow + 1)
    
    If Not Intersect(Target, intersectRange) Is Nothing Then
        On Error Resume Next
        oldCellText = ActiveCell.Offset(-1, 0)
        ActiveCell.Offset(-1, 0) = QuyChuanHoTen(oldCellText)
    End If
    
End Sub

Bài đã được tự động gộp: 1/6/24

@Hoàng Tuấn 868 : tại sao bạn dùng WS_Change mà không dùng WS_SelectionChange?

 

[Hoàng Tuấn 868]

@Hoàng Tuấn 868: tại sao bạn dùng WS_Change mà không dùng WS_SelectionChange?

Em copy từ một code cũ sang rồi sửa lõi nên cứ để nguyên vậy anh ạ.

 

[VetMini]

Nhìn bài bạn Tuấn 868 mới ngộ ra cách dùng ActiveCell....

...
    If Not Intersect(Target, intersectRange) Is Nothing Then
        On Error Resume Next
        oldCellText = ActiveCell.Offset(-1, 0)
        ActiveCell.Offset(-1, 0) = QuyChuanHoTen(oldCellText)
    End If
End Sub

Bài đã được tự động gộp: 1/6/24

@Hoàng Tuấn 868 : tại sao bạn dùng WS_Change mà không dùng WS_SelectionChange?

1. Tôi chưa hiểu tại sao dùng ActiveCell.
Theo code thì bạn măc định rằng người dùng đã 'Enter'. Trên thực tế người ta vẫn có thể đã 'Tab'
2. dùng WS_Change mà không dùng WS_SelectionChange?
ngoài việc khác sự kiện, điểm chính là Target. Với cách thứ nhất Target là ô mới vừa được sửa. Với cách thứ hai, Target là ô mới vừa được chọn (với cửa/enter thì nó là ô dưới ô vừa được sửa).

Đừng gọi Thầy, gọi anh cũng được rồi (cho thấy trẻ).
...

Không nên gọi là thầy nhé.
...

Tôi lại ao ước người ta gọi mình là Thầy. Và theo trào lưu thích thích gì đó, tôi chọn cái tên Thầy Thích Nón Gai cho nó bình dân.

 

[Hoàng Tuấn 868]

"Thầy Thích Nón Gai" cho nó bình dân.

Nhỡ Nón không Gai lại mừng hụt anh ơi.

 

[VetMini]

Nhỡ Nón không Gai lại mùng hụt anh ơi.

Mình sợ có gai chứ sao lại sợ không gai?

 

[ongke0711]

Trên thực tế người ta vẫn có thể đã 'Tab'

Bẫy lỗi {TAB} này cũng căng à anh...Đã có Tab thì cũng có mũi tên trái phải, lên xuống...
Thêm cái code này mà chạy chưa được.

With Application
   .OnKey "{TAB}", "quyChuanHoTen_ex"
   Exit Sub
End With

 

[ongke0711]

File đính kèm cũng tạm xử lý được phím {TAB} nhưng giải thuật này vẫn bị phải bấm phím {Enter} hoặc {Tab} 2 lần nó mới di chuyển... .
Thôi bỏ cuộc vậy.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim intersectRange As Range
    Dim lastRow As Long
    Const targetCol As String = "C"
    Const startRow As Long = 2

    lastRow = Cells(Rows.Count, targetCol).End(xlUp).Row
    Set intersectRange = Range(targetCol & startRow & ":" & targetCol & lastRow + 1)

    If Not Intersect(Target, intersectRange) Is Nothing Then
        On Error Resume Next
        Application.OnKey "{RETURN}", "QuyChuanHoTen_ex2"
        Application.OnKey "{TAB}", "QuyChuanHoTen_ex"
    End If
End Sub

 

[cantl]

Cái này hay nè, nhớ lúc nhỏ Thầy Cô dạy +-*/ mà thừa thì nhớ tạm đâu đó, thế là em ứng dụng vào luôn.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tempO As Range
    Application.EnableEvents = False
    Set tempO = Intersect(Target, Range("c5:c250"))
    If Not tempO Is Nothing Then
        tempO.Value = Application.Trim(Application.Proper(tempO.Value))
    End If
    Application.EnableEvents = True
End Sub

 

[VetMini]

Cần giải thích tại sao dùng Application.Trim mà không dùng Trim của VBA.
Như trên, tại sao dùng Application.Proper mà không dùng StrConv của VBA.

Tôi biết tại sao. Nhưng nếu để người viết code giải thích thì tốt hơn.

 

[ongke0711]

Cái này hay nè, nhớ lúc nhỏ Thầy Cô dạy +-*/ mà thừa thì nhớ tạm đâu đó, thế là em ứng dụng vào luôn.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tempO As Range
    Application.EnableEvents = False
    Set tempO = Intersect(Target, Range("c5:c250"))
    If Not tempO Is Nothing Then
        tempO.Value = Application.Trim(Application.Proper(tempO.Value))
    End If
    Application.EnableEvents = True
End Sub

Giờ mới biết cái hàm Trim này nó bỏ luôn khoảng trắng dư thừa ở giữa các từ. Trước giờ tôi chỉ dùng nó để bỏ khoảng trắng đầu và cuối chuỗi. Bên Access không có hàm Proper(), phải tự viết hàm này hoặc dùng strConv() và hàm Trim cũng xử lý khác Trim Excel.

 

[Hoàng Tuấn 868]

Giờ mới biết cái hàm Trim này nó bỏ luôn khoảng trắng dư thừa ở giữa các từ. Trước giờ tôi chỉ dùng nó để bỏ khoảng trắng đầu và cuối chuỗi. Bên Access không có hàm Proper(), phải tự viết hàm này hoặc dùng strConv() và hàm Trim cũng xử lý khác Trim Excel.

Nếu hàm Trim thông thường trong VBA thì chỉ bỏ khoảng trắng thừa hai đầu đoạn văn thôi mà không bỏ được các khoảng trắng thừa bên trong.
Còn lồng hàm Trim theo kiểu đưa từ Excel vào thì nó sẽ có tác dụng với toàn bộ đoạn văn anh ạ.

 

[ongke0711]

Viết lại cái hàm giống giống Application.Trim để xài tạm bên Access

Function TrimAll(sText As String) As String
    Dim arr() As String, sRet As String, i As Long
    
    arr = Split(sText, " ")
    For i = 0 To UBound(arr)
        If Len(arr(i)) > 0 Then
            sRet = sRet & (arr(i)) & " "
        End If
    Next
    TrimAll = Trim(sRet)
End Function

 

[cantl]

Cần giải thích tại sao dùng Application.Trim mà không dùng Trim của VBA.
Như trên, tại sao dùng Application.Proper mà không dùng StrConv của VBA.

Tôi biết tại sao. Nhưng nếu để người viết code giải thích thì tốt hơn.

Bác thử cho biết tại sao với, chứ em dùng vì:
1 đơn giản là không biết code sao cho gọn nên cứ dùng hàm bảng tính, tất nhiên dùng kiểu này thì không pờ rồ.
2 là trim thì nó không chạy nên em thêm App vào thôi.
3 là gõ app nó không bị lỗi gõ ư như worksheetfunction.
Hề hề.

 

[VetMini]

À thì cũng do cái thói "lỗi mà không biết cách chữa thì cứ viêc 'On Error Resume Next'"

- Hàm Trim của VBA chỉ trim các khoảng trắng đầu và đuôi chuỗi. Hàm Trim của bảng tính (gọi qua Application hay WorkSheetFunction) sẽ trim các khoảng trắng đầu/đuôi chuỗi, đồng thời giới hạn khoảng cách giữa 2 từ ở mức 1 khoảng trắng.

- Hàm StrConv, cái này thì dễ hiểu, là hàm chỉ hoạt động trên String. Vì vậy, chỉ có thể nạp 1 ô cho nó thôi. Hàm Applcation.Proper nhận cả một range.

Chú thích cho các bạn chưa biết chuyện "lỗi mà không biết cách chữa thì cứ viêc 'On Error Resume Next'":
Đây là cách lười biếng để giúp code vượt qua lỗi tính toán. Lưu ý từ "lỗi tính toán", vì vậy loại code này có thể cho ra kết quả sai mà người dùng khó biết.
Kết quả sai mà không biết thì bảng tính chỉ là một đống rác.