Hỗ trợ viết hoa dữ liệu theo quy luật

[Tình nghĩa giang hồ]

Chào anh chị em có vấn đề này, nhờ anh chị hỗ trợ giúp em với.

Quy luật 1: Viết hoa chữ cái đầu



Quy luật 2: Viết hoa toàn bộ

1_Viết hoa toàn bộ đối với chữ và số

VD: MEL104SH, LK1179A, LK4510A, 900X2200X110MM….

2_Viết hoa toàn bộ đối với phụ âm

Phụ âm: b, c, d, f, g, h, j, k, l, m, n, p, k, r, s, t, v, w, x, y, z (tiếng việt thì có thêm đ )

VD: WC, KT…….



Nhờ anh chị hỗ trợ giúp em trường hợp này.

Em cảm ơn anh chị



Trước đây em cũng có nhờ hỗ trợ trường hợp hơi tương tự 1 phần bài này.

(Link tham khảo viết hoa phụ âm)

Nhờ viết hoa dữ liệu theo quy luật

Chào anh chị em có vấn đề này, nhờ anh chị hỗ trợ giúp em với. Quy luật 1: CÔNG TY => Công ty Các trường hợp khác thì viết hoa chữ cái đầu Quy luật 2: TNHH => TNHH MTV => MTV CP => CP Nguyên âm: a, e, o, i, u Phụ âm: b, c, d, f, g, h, j, k, l, m, n, p, k, r, s, t, v, w, x, y, z (tiếng...

www.giaiphapexcel.com

 

[Tình nghĩa giang hồ]

Vấn đề của em cuối cùng cũng được giải quyết, mặc dù hơi chắp vá, xin chia sẽ cho những ai gặp vấn đề tương tự

Function Viet_hoa_chu_va_so(str As String) As String
Dim RE As Object
Set RE = CreateObject("VBScript.RegExp")
RE.Pattern = "\d"
Dim arr
arr = Split(str, " ")
Dim i As Long
For i = LBound(arr) To UBound(arr)
If RE.test(arr(i)) Then
arr(i) = UCase(arr(i))
End If
Next
Viet_hoa_chu_va_so = Join(arr, " ")
End Function


Function Viet_hoa_phu_am(ByVal str As String) As String
Dim S, i As Long, j As Long, PhuAm As String

PhuAm = "b,c,d,f,g,h,j,k,l,m,n,p,q,r,s,t,v,w,x,y,z," & ChrW(273)
str = LCase(str)

S = Split(str, " ")
For j = 0 To UBound(S)
For i = 1 To Len(S(j))
If InStr(1, PhuAm, Mid(S(j), i, 1), vbTextCompare) = 0 Then Exit For
Next i
If i > Len(S(j)) Then
S(j) = UCase(S(j))
End If

Next j
Viet_hoa_phu_am = Join(S, " ")
End Function

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

Em vẫn hy vọng có được góc nhìn khác về vấn đề này, hoặc là một đoạn code nào làm tất cả trong một. Cảm ơn anh chị.

 

[CHAOQUAY]

Chào anh chị em có vấn đề này, nhờ anh chị hỗ trợ giúp em với.

Quy luật 1: Viết hoa chữ cái đầu



Quy luật 2: Viết hoa toàn bộ

1_Viết hoa toàn bộ đối với chữ và số

VD: MEL104SH, LK1179A, LK4510A, 900X2200X110MM….

2_Viết hoa toàn bộ đối với phụ âm

Phụ âm: b, c, d, f, g, h, j, k, l, m, n, p, k, r, s, t, v, w, x, y, z (tiếng việt thì có thêm đ )

VD: WC, KT…….



Nhờ anh chị hỗ trợ giúp em trường hợp này.

Em cảm ơn anh chị



Trước đây em cũng có nhờ hỗ trợ trường hợp hơi tương tự 1 phần bài này.

(Link tham khảo viết hoa phụ âm)

Nhờ viết hoa dữ liệu theo quy luật

Chào anh chị em có vấn đề này, nhờ anh chị hỗ trợ giúp em với. Quy luật 1: CÔNG TY => Công ty Các trường hợp khác thì viết hoa chữ cái đầu Quy luật 2: TNHH => TNHH MTV => MTV CP => CP Nguyên âm: a, e, o, i, u Phụ âm: b, c, d, f, g, h, j, k, l, m, n, p, k, r, s, t, v, w, x, y, z (tiếng...

www.giaiphapexcel.com

Chạy thử code dưới đây

Option Explicit

Sub VietHoa()
Dim Dulieu
Dim PhuAm As String
Dim Kq
Dim rws, i, j, k

PhuAm = UCase("b,c,d,f,g,h,j,k,l,m,n,p,q,r,s,t,v,w,x,y,z," & ChrW(273))
Dulieu = Sheet1.Range("A2:A19")
rws = UBound(Dulieu)
ReDim Kq(1 To rws, 1 To 1)
With CreateObject("VBScript.RegExp")
    .IgnoreCase = False
    .Pattern = "( [" & PhuAm & "]+ )*" & "[A-Z]+\d+[A-Z]+"
    For i = 1 To rws
        If .test(Dulieu(i, 1)) Then
            j = .Execute(Dulieu(i, 1))(0).FirstIndex
            k = Len(Dulieu(i, 1))
            
            Kq(i, 1) = Left(Dulieu(i, 1), 1) & LCase(Mid(Dulieu(i, 1), 2, j - 1)) & Right(Dulieu(i, 1), k - j)
        End If
    Next i
End With

With Sheet1
    .Range("B2").Resize(rws, 1) = Kq
End With
End Sub

 

[Tình nghĩa giang hồ]

Hay quá, em cảm ơn anh ChaoQuay nhiều.

 

[HeSanbi]

Hay quá, em cảm ơn anh ChaoQuay nhiều.

Bạn có thể giải thích code hay chỗ nào không?

 

[Tình nghĩa giang hồ]

Bạn có thể giải thích code hay chỗ nào không?

Dạ, hay ở chỗ bài của em chấp vá 3 phần mới giải quyết được đó anh HeSanbi. Giờ bài này anh ChaoQuy gộp lại làm 1 phần là giải quyết được đó anh.
Em đang tìm hiểu cách gộp lại 1 phần bằng Funtion, cho dễ sử dụng hơn tí.......
Còn đánh giá code nhanh code chậm, hay đánh giá cao siêu thì trình em không tới đó.......với lại phận nhờ cậy.......người ta giúp được mình là vui lắm rồi anh. Hi hi

 

[HeSanbi]

Dạ, hay ở chỗ bài của em chấp vá 3 phần mới giải quyết được đó anh HeSanbi. Giờ bài này anh ChaoQuy gộp lại làm 1 phần là giải quyết được đó anh.
Em đang tìm hiểu cách gộp lại 1 phần bằng Funtion, cho dễ sử dụng hơn tí.......
Còn đánh giá code nhanh code chậm, hay đánh giá cao siêu thì trình em không tới đó.......với lại phận nhờ cậy.......người ta giúp được mình là vui lắm rồi anh. Hi hi

Bạn thử:
khung bao nẹp cửa wc lk1179a. kt 800x2200x110mm
khung bao nẹp cửa WC LK1179A. KT 800X2200X110MM
Xem có đủ các điều kiện không, nếu không thì thử code sau:

Sub VietHoa()
  Dim r, a, lr, i, s, ms
  Set r = Range("A2")
  lr = r(Rows.Count - r.Row, 1).End(3).Row - r.Row + 1
  If lr < 1 Then Exit Sub
  a = r.Resize(lr).Value
  With VBA.CreateObject("VBScript.RegExp")
    .IgnoreCase = True
    .Pattern = " [ a-z0-9.]+$"
    For i = 1 To lr
      s = LCase(a(i, 1))
      If s <> Empty Then
        Set ms = .Execute(s)
        If ms.Count Then s = Replace(s, ms(0), UCase(ms(0)))
        Mid(s, 1, 1) = UCase(Left(s, 1))
        a(i, 1) = s
      End If
    Next i
  End With
  Range("B2").Resize(lr, 1) = a
End Sub

 

[Tình nghĩa giang hồ]

Bạn thử:
khung bao nẹp cửa wc lk1179a. kt 800x2200x110mm
khung bao nẹp cửa WC LK1179A. KT 800X2200X110MM
Xem có đủ các điều kiện không, nếu không thì thử code sau:

Sub VietHoa()
  Dim r, a, lr, i, s, ms
  Set r = Range("A2")
  lr = r(Rows.Count - r.Row, 1).End(3).Row - r.Row + 1
  If lr < 1 Then Exit Sub
  a = r.Resize(lr).Value
  With VBA.CreateObject("VBScript.RegExp")
    .IgnoreCase = True
    .Pattern = " [ a-z0-9.]+$"
    For i = 1 To lr
      s = a(i, 1)
      If s <> Empty Then
        Set ms = .Execute(s)
        If ms.Count Then s = Replace(s, ms(0), UCase(ms(0)))
        Mid(s, 1, 1) = UCase(Left(s, 1))
        a(i, 1) = s
      End If
    Next i
  End With
  Range("B2").Resize(lr, 1) = a
End Sub

dạ, em cảm ơn anh HeSanbi

 

[CHAOQUAY]

Dạ, hay ở chỗ bài của em chấp vá 3 phần mới giải quyết được đó anh HeSanbi. Giờ bài này anh ChaoQuy gộp lại làm 1 phần là giải quyết được đó anh.
Em đang tìm hiểu cách gộp lại 1 phần bằng Funtion, cho dễ sử dụng hơn tí.......
Còn đánh giá code nhanh code chậm, hay đánh giá cao siêu thì trình em không tới đó.......với lại phận nhờ cậy.......người ta giúp được mình là vui lắm rồi anh. Hi hi

Bài của bạn khó nhất là cái "WC"
Trong file mẫu WC viết hoa nên code vậy, còn cái wc viết thường phải khác. "True" và "False" là vậy.