Nhờ viết code tự động định dạng như Superscript (1 người xem)

[tungnguyen_kt]

Trong một bảng tính excel như sau:

Tôi phải thường xuyên gõ như thế này, ví dụ như: 303/4 sau đó bôi đen "3/4" vào định dạng Superscript cho "3/4" này nhảy lên trên (số liệu như hình trên)

Vậy cho em hỏi có cách nào nhanh hơn cách em làm không để em gõ và enter là phần này nhảy lên trên cho lẹ.

Hay có thể viết giúp code dùm: Đại loại như gõ 30A3/4 thì nó hiểu những gì sau chữ A là định dạng SuperScript giúp em.

 

[leonguyenz]

Trong một bảng tính excel như sau:
Tôi phải thường xuyên gõ như thế này, ví dụ như: 303/4 sau đó bôi đen "3/4" vào định dạng Superscript cho "3/4" này nhảy lên trên (số liệu như hình trên)
Vậy cho em hỏi có cách nào nhanh hơn cách em làm không để em gõ và enter là phần này nhảy lên trên cho lẹ.
Hay có thể viết giúp code dùm: Đại loại như gõ 30A3/4 thì nó hiểu những gì sau chữ A là định dạng SuperScript giúp em.

Tùng tham khảo bài Add-Ins chuyển đổi nhanh ký tự dạng superscript của anh Kiệt xem sao.

 

[tungnguyen_kt]

Tùng tham khảo bài Add-Ins chuyển đổi nhanh ký tự dạng superscript của anh Kiệt xem sao.

Cũng chưa ăn thua anh Thảo ơi, vì kiểu như "3/4" là rất nhiều và đa dạng số, với lại cũng nhiều bước quá. Cứ viết code định dạng làm sao mà cứ sau chứ A hay B hay C gì đó là nó định dạng Superscript các số sau đó là ok.

 

[Quang_Hải]

Trong một bảng tính excel như sau:

Tôi phải thường xuyên gõ như thế này, ví dụ như: 303/4 sau đó bôi đen "3/4" vào định dạng Superscript cho "3/4" này nhảy lên trên (số liệu như hình trên)

Vậy cho em hỏi có cách nào nhanh hơn cách em làm không để em gõ và enter là phần này nhảy lên trên cho lẹ.

Hay có thể viết giúp code dùm: Đại loại như gõ 30A3/4 thì nó hiểu những gì sau chữ A là định dạng SuperScript giúp em.

Thử cái này. Nếu đúng thì nên làm gì cho đúng nhé
*** Code mang tính tham khảo. Khi xài phải sửa lại cho nó đúng chỗ, nếu không thì gõ chỗ nào cũng bị Superscript

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target.Characters(Len(Target) - 2, 3).Font
        .Size = 10
        .Superscript = True
    End With
End Sub

 

[tungnguyen_kt]

Thử cái này. Nếu đúng thì nên làm gì cho đúng nhé

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target.Characters(Len(Target) - 2, 3).Font
        .Size = 10
        .Superscript = True
    End With
End Sub

Đã test xong, chạy ngon lành, cảm ơn anh Hải nhé!
Có điều làm sao code chạy trên file chứ không chạy trên từng sheet

 

[leonguyenz]

Thử cái này. Nếu đúng thì nên làm gì cho đúng nhé
*** Code mang tính tham khảo. Khi xài phải sửa lại cho nó đúng chỗ, nếu không thì gõ chỗ nào cũng bị Superscript

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target.Characters(Len(Target) - 2, 3).Font
        .Size = 10
        .Superscript = True
    End With
End Sub

Em cũng test theo kiểu Marco này, nhưng hình như không tiện, Target có độ dài ngắn quá; Tùng muốn dùng Onkey ...
Marco có thể rút gọn:

Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Characters(Len(Target) - 2, 3).Font.Superscript = True
End Sub

 

[tungnguyen_kt]

Em cũng test theo kiểu Marco này, nhưng hình như không tiện, Target có độ dài ngắn quá; Tùng muốn dùng Onkey ...
Marco có thể rút gọn:

Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Characters(Len(Target) - 2, 3).Font.Superscript = True
End Sub

Em thử gõ vài hàng sau đó bôi đen xóa thì thì nó báo lỗi code, không biết lý do gì. nếu nhập một ô và xóa thì không sao.

 

[tungnguyen_kt]

và một lỗi nữa là nếu gõ xong và xóa bằng delete thì gõ lại chính ô đó thì nó không định dạng được nữa.

 

[Quang_Hải]

Đã test xong, chạy ngon lành, cảm ơn anh Hải nhé!
Có điều làm sao code chạy trên file chứ không chạy trên từng sheet

Cho code vào ThisWorkBook nha. Sửa lại chỗ A5:F100 cho phù hợp nếu không thì gõ chỗ nào cũng bị Super

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   If Not Intersect(Target, [A5:F100]) Is Nothing Then
      With Target
         If .Value <> Empty Then
            Application.EnableEvents = False
             With .Characters(Len(Target) - 2, 3).Font
               .Size = 10
               .Superscript = True
               End With
            Application.EnableEvents = True
         End If
      End With
   End If
End Sub

 

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

Tùng thử như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
If InStr(Target.Text, "/") Then
    Target.Characters(InStr(Target.Text, "/") - 1, 3).Font.Superscript = True
Else
    Target.Font.Superscript = False
End If
End Sub

 

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

Cho code vào ThisWorkBook nha. Sửa lại chỗ A5:F100 cho phù hợp nếu không thì gõ chỗ nào cũng bị Super

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   If Not Intersect(Target, [A5:F100]) Is Nothing Then
      With Target
         If .Value <> Empty Then
            Application.EnableEvents = False
             With .Characters(Len(Target) - 2, 3).Font
               .Size = 10
               .Superscript = True
               End With
            Application.EnableEvents = True
         End If
      End With
   End If
End Sub

Phải trả lại mặc định khi gõ lại cell đã có Superscript khi không thỏa điều kiện.

 

[tungnguyen_kt]

Tùng thử như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
If InStr(Target.Text, "/") Then
    Target.Characters(InStr(Target.Text, "/") - 1, 3).Font.Superscript = True
Else
    Target.Font.Superscript = False
End If
End Sub

Trường hợp gõ 12/2 thì nó nhày sang dạng ngày tháng, nó hiểu là ngày 12 tháng 2.

Với lại code bỏ vào sheet nào thì sheet đó chạy, còn bỏ vào ThisWorkook thì hỏng thấy chạy gì cả.

 

[sealand]

Muốn bỏ vào ThisWorkbook em phải thay dòng:


Private Sub Worksheet_Change(ByVal Target As Range)


Thành:




Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

 

[tungnguyen_kt]

Muốn bỏ vào ThisWorkbook em phải thay dòng:


Private Sub Worksheet_Change(ByVal Target As Range)



Thành:




Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dạ em cảm ơn Anh.

Nhưng vẫn đề như trên vẫn chưa được là: code chạy 12/2 thì nó hiểu là ngày tháng năm.
- code anh Hải thì xóa một khối ô thì lỗi code

 

[Quang_Hải]

Dạ em cảm ơn Anh.

Nhưng vẫn đề như trên vẫn chưa được là: code chạy 12/2 thì nó hiểu là ngày tháng năm.
- code anh Hải thì xóa một khối ô thì lỗi code

Code của mình chỉ là hướng giải quyết vấn đề thôi. Thực tế phải sửa lại chứ. Anh tưởng Tùng xử được nên viết nửa chừng.
Còn nếu gõ 12/2 thì muốn nó ra cái gì???

 

[dhn46]

Anh định dạng Text cho vùng dữ liệu rồi sử dụng Code sau

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Pos As Long, Lenght As Long
    With CreateObject("Vbscript.Regexp")
        .Global = True
        .Pattern = "\s\d+/\d+\s*|$"
        Pos = .Execute(Target.Text).Item(0).FirstIndex + 1
        Lenght = Len(.Execute(Target).Item(0))
    End With
    Target.Characters(Pos, Lenght).Font.Superscript = True
End Sub

Với dạng này anh sẽ gõ như sau:
1/ Số dấu cách đến phân số (Ví dụ: 12 123/456)
2/ Code này cũng đúng cho trường hợp có thêm phần phía sau với điều kiện thêm 1 dấu cách phía sau phân số (Ví dụ 123 456/789 Cm)

 

[tungnguyen_kt]

Code của mình chỉ là hướng giải quyết vấn đề thôi. Thực tế phải sửa lại chứ. Anh tưởng Tùng xử được nên viết nửa chừng.
Còn nếu gõ 12/2 thì muốn nó ra cái gì???

Hehe... em đâu đủ trình độ sửa code anh hải chứ. 12/2 tất nhiên vẫn là 1 rồi định dãng Superscript 2/2

 

[sealand]

Đừng nên thay đổi quá nhiều đối với những quy định hệ thống dẫn đến nhiều hậu quả không lường trước. Để giải quyết vấn đề này em chỉ cần định dạng vùng nhập thành Text hoặc khi nhâp gõ dấu " ' " roi gõ 12/2 là được

 

[Quang_Hải]

Hehe... em đâu đủ trình độ sửa code anh hải chứ. 12/2 tất nhiên vẫn là 1 rồi định dãng Superscript 2/2

Nếu được thì định dạng vùng xử lý là Text trước nhé, rồi cho code này vào coi nó ra cái chi

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Dim chk
   If Not Intersect(Target, [A5:F100]) Is Nothing Then
      If Target.Count = 1 Then
         With Target
            If .Value <> Empty Then
               chk = InStr(Target, "/")
               If chk Then
                  With .Characters(chk - 1, Len(Target) + 2 - chk).Font
                     .Size = 10
                     .Superscript = True
                  End With
               End If
            End If
         End With
      End If
   End If
Application.EnableEvents = True
End Sub