Xử lý chuỗi Họ tên có giới hạn 20 ký tự để in thẻ ATM (2 người xem)

[cuonghv]

Chào các bạn, mình làm ở bộ phận phát hành thẻ ATM của 1 ngân hàng. Mình có 1 vấn đề cần giải quyết như sau: Vì trên thẻ ATM có giới hạn số ký tự của họ tên là 20 nên bắt buộc phải cắt bớt các ký tự trong chuỗi họ tên.
Ví dụ:
- Nguyễn Hoàng Phương Dung (24 ký tự) cắt thành Nguyễn H Phương Dung (20 ký tự)
- Huỳnh Thị Phương Duyên (22) cắt thành Huỳnh T Phươmg Duyên (20 ký tự)
Mong các bạn cho mình giải pháp xử lý trên Excel.
Cám ơn nhiều.

 

[ndu96081631]

Chào các bạn, mình làm ở bộ phận phát hành thẻ ATM của 1 ngân hàng. Mình có 1 vấn đề cần giải quyết như sau: Vì trên thẻ ATM có giới hạn số ký tự của họ tên là 20 nên bắt buộc phải cắt bớt các ký tự trong chuỗi họ tên.
Ví dụ:
- Nguyễn Hoàng Phương Dung (24 ký tự) cắt thành Nguyễn H Phương Dung (20 ký tự)
- Huỳnh Thị Phương Duyên (22) cắt thành Huỳnh T Phươmg Duyên (20 ký tự)
Mong các bạn cho mình giải pháp xử lý trên Excel.
Cám ơn nhiều.

Nếu có ai đó tên kiểu vầy: Nguyễn Thị Phương Phương, Nguyễn Thị Nghiêng Nghiêng thì.. cắt sao đây?

 

[Hoàng Trọng Nghĩa]

Chào các bạn, mình làm ở bộ phận phát hành thẻ ATM của 1 ngân hàng. Mình có 1 vấn đề cần giải quyết như sau: Vì trên thẻ ATM có giới hạn số ký tự của họ tên là 20 nên bắt buộc phải cắt bớt các ký tự trong chuỗi họ tên.
Ví dụ:
- Nguyễn Hoàng Phương Dung (24 ký tự) cắt thành Nguyễn H Phương Dung (20 ký tự)
- Huỳnh Thị Phương Duyên (22) cắt thành Huỳnh T Phương Duyên (20 ký tự)
Mong các bạn cho mình giải pháp xử lý trên Excel.
Cám ơn nhiều.

Xử lý chuỗi theo công thức quá rắc rối và phức tạp, công thức dài lê thê nhưng chưa chắc đã đúng hoàn toàn, cho nên tôi nghĩ là chúng ta nên dùng hàm tự tạo.

Trường hợp 1:

Nguyễn Hoàng Phương Dung (24 ký tự) cắt thành Nguyễn H Phương Dung (20 ký tự) --> OK

Trường hợp 2:

Huỳnh Thị Phương Nguyên (23) cắt thành Huỳnh T P Nguyên (16 ký tự) --> phải vậy không?

Trường hợp 3:

Nguyễn Hoàng Tô Ánh Nguyệt (26) cắt thành Nguyễn H T Á Nguyệt (19 ký tự) --> Chữ Á xử lý thế nào?

Trường hợp 4:

Tôn Tần Tôn Nữ Hoàng Thị Phương Khanh (37) cắt thành Tôn T T N H T P Khanh (21 ký tự) --> xử lý sao đây khi cắt hết mà nó vẫn dư ra 21 ký tự?


Hàm cắt tên tự tạo tạm thời xử lý trường hợp 1, và 2 còn trường hợp khác đợi tác giả trả lời thì tính tiếp.

Public Function CatTen(ByVal Str As String, LenText As Long) As String
      Dim HoTen As String
      HoTen = WorksheetFunction.Trim(Str)
      If Len(HoTen) <= LenText Then
            CatTen = HoTen
      Else
            Dim Arr(), sTemp, Tmp As String, n As Long, i As Long
            Dim Ho As String, Ten As String, TenLot As String, HT As String
            Dim isTen As Boolean, Lot As String, sTen As String
            
            Ho = Left(HoTen, InStr(HoTen, " "))
            TenLot = Replace(HoTen, Ho, "", , 1)
            sTemp = Split(TenLot)
            isTen = False
            
            For i = 0 To UBound(sTemp)
                  Tmp = sTemp(i)
                  n = n + 1
                  ReDim Preserve Arr(1 To n)
                  Arr(n) = IIf(i = UBound(sTemp), Tmp, Left(Tmp, 1))
                  CatTen = Ho & Join(Arr, " "): HT = Replace(HoTen, CatTen, "", , 1)
                  Lot = Left(HT, InStr(HT, " ")): HT = Replace(HT, Lot, "", , 1)
                  sTen = CatTen & " " & HT
                  If Len(sTen) <= LenText Then isTen = True: Exit For
            Next
            
            If isTen Then
                  CatTen = sTen
            Else
                  CatTen = CatTen
            End If
      End If
End Function

Cấu trúc hàm CatTen:

=CatTen(chuoi,so_ky_tu)

 

[cuonghv]

Cám ơn bạn đã đưa ra giải pháp. Về trường hợp 3, thì chữ Á thành chữ A. Trường hợp 4 thì mình chưa thấy ai mở thẻ ATM có tên dài như vậy cả.
À. Giải pháp của bạn vẫn còn một chút lỗi nhỏ. Mình đã test thử:- TRẦN LÊ THỊ THÙY TRANG (len=23) lại cắt thành TRẦN L T T TRANG (len=16). Đúng ra phải cắt là TRẦN L T THÙY TRANG (len=19).

 

[cuonghv]

Cám ơn bạn đã đưa ra giải pháp. Về trường hợp 3, thì chữ Á thành chữ A. Trường hợp 4 thì mình chưa thấy ai mở thẻ ATM có tên dài như vậy cả.
À. Giải pháp của bạn vẫn còn một chút lỗi nhỏ. Mình đã test thử:- TRẦN LÊ THỊ THÙY TRANG (len=23) lại cắt thành TRẦN L T T TRANG (len=16). Đúng ra phải cắt là TRẦN L T THÙY TRANG (len=19).

 

[ndu96081631]

Cám ơn bạn đã đưa ra giải pháp. Về trường hợp 3, thì chữ Á thành chữ A. Trường hợp 4 thì mình chưa thấy ai mở thẻ ATM có tên dài như vậy cả.
À. Giải pháp của bạn vẫn còn một chút lỗi nhỏ. Mình đã test thử:- TRẦN LÊ THỊ THÙY TRANG (len=23) lại cắt thành TRẦN L T T TRANG (len=16). Đúng ra phải cắt là TRẦN L T THÙY TRANG (len=19).

Hình như yêu cầu cắt tên của bạn chẳng có quy luật gì cả, thích cắt sao thì cắt hay sao ấy
Như ở topic này:
http://www.giaiphapexcel.com/forum/...ới-chiều-dài-quá-18-ký-tự&p=441433#post441433
Người ta có quy luật đàng hoàng: Cắt từ chữ cạnh bên tên và cắt dần về phía bên trái đến khi nào đủ số lượng ký tự thì ngưng
Còn quy luật của bạn là gì đây?

 

[cuonghv]

Hình như yêu cầu cắt tên của bạn chẳng có quy luật gì cả, thích cắt sao thì cắt hay sao ấy
Như ở topic này:
http://www.giaiphapexcel.com/forum/...ới-chiều-dài-quá-18-ký-tự&p=441433#post441433
Người ta có quy luật đàng hoàng: Cắt từ chữ cạnh bên tên và cắt dần về phía bên trái đến khi nào đủ số lượng ký tự thì ngưng
Còn quy luật của bạn là gì đây?

Quy luật của mình ngược lại với topic đó. cắt từ chữ cạnh họ trước và cắt dần về bên phải cho đén giơi hạn 20 ký tự.

 

[ndu96081631]

Quy luật của mình ngược lại với topic đó. cắt từ chữ cạnh họ trước và cắt dần về bên phải cho đén giơi hạn 20 ký tự.

Cắt vậy e rằng không hợp lý!
Trong trường hợp "cắt tiệt" toàn bộ mà vẫn > 20 ký tự, khi ấy chẳng lẽ bạn "thiến" luôn tên? Trong khi tôi nghĩ thà cắt họ còn tên thì phải luôn giữ lại mới hợp lý
Tên dài bạn chưa thấy nhưng không phải là không có đâu. Vậy nên viết code là phải lường trước trường hợp tổng quát nhất
-----------
Tuy nhiên nếu bạn thích thì vẫn code ấy, sửa ngược lại là được:

Function NameLimit(ByVal Text As String, Length_Limit As Long) As String
  Dim tmp As String, tmpName As String
  Dim Arr
  Dim lPos As Long, length As Long
  On Error Resume Next
  tmp = WorksheetFunction.Trim(Text)
  NameLimit = tmp
  If Len(tmp) > Length_Limit Then
    Arr = Split(tmp, " ")
    lPos = 1
    Do
      Arr(lPos) = Left(Arr(lPos), 1)
      tmpName = Join(Arr, " ")
      length = Len(tmpName)
      lPos = lPos + 1
    Loop Until (length <= Length_Limit Or lPos > UBound(Arr))
    NameLimit = tmpName
  End If
End Function

Áp dụng: =NameLimit(A1,20) chẳng hạn

 

[Hoàng Trọng Nghĩa]

Cắt vậy e rằng không hợp lý!
Trong trường hợp "cắt tiệt" toàn bộ mà vẫn > 20 ký tự, khi ấy chẳng lẽ bạn "thiến" luôn tên? Trong khi tôi nghĩ thà cắt họ còn tên thì phải luôn giữ lại mới hợp lý
Tên dài bạn chưa thấy nhưng không phải là không có đâu. Vậy nên viết code là phải lường trước trường hợp tổng quát nhất
-----------
Tuy nhiên nếu bạn thích thì vẫn code ấy, sửa ngược lại là được:

Function NameLimit(ByVal Text As String, Length_Limit As Long) As String
  Dim tmp As String, tmpName As String
  Dim Arr
  Dim lPos As Long, length As Long
  On Error Resume Next
  tmp = WorksheetFunction.Trim(Text)
  NameLimit = tmp
  If Len(tmp) > Length_Limit Then
    Arr = Split(tmp, " ")
    lPos = 1
    Do
      Arr(lPos) = Left(Arr(lPos), 1)
      tmpName = Join(Arr, " ")
      length = Len(tmpName)
      lPos = lPos + 1
    Loop Until (length <= Length_Limit Or lPos > UBound(Arr))
    NameLimit = tmpName
  End If
End Function

Áp dụng: =NameLimit(A1,20) chẳng hạn

Hàm của Thầy thì quá tuyệt rồi, trường hợp tên quá dài theo em là hiếm, vì vậy nếu gặp phải thì đành phải tự sửa thủ công thôi. Tuy nhiên, với một yêu cầu của tác giả là những tên lót nguyên âm thì loại dấu tiếng Việt. Sau đây em sẽ thêm một hàm chuyển text ở font Unicode về dạng không dấu cho hàm của Thầy:

Function UniToKhongDau(ByVal UniText As String) As String
      
      Dim ArrUNI As Variant, ArrALP As Variant
      Dim i As Long, j As Long
      Dim inString As String
          
      ArrUNI = Array(225, 224, 7843, 227, 7841, 226, 7845, 7847, 7849, 7851, 7853, 259, 7855, 7857, 7859, 7861, 7863, 273, 233, _
               232, 7867, 7869, 7865, 234, 7871, 7873, 7875, 7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, _
               7885, 244, 7889, 7891, 7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, 432, _
               7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925, 193, 192, 7842, 195, 7840, 194, 7844, 7846, 7848, _
               7850, 7852, 258, 7854, 7856, 7858, 7860, 7862, 272, 201, 200, 7866, 7868, 7864, 202, 7870, 7872, 7874, 7876, _
               7878, 205, 204, 7880, 296, 7882, 211, 210, 7886, 213, 7884, 212, 7888, 7890, 7892, 7894, 7896, 416, 7898, 7900, _
               7902, 7904, 7906, 218, 217, 7910, 360, 7908, 431, 7912, 7914, 7916, 7918, 7920, 221, 7922, 7926, 7928, 7924)
      
      ArrALP = Array("a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "d", "e", "e", "e", "e", "e", _
               "e", "e", "e", "e", "e", "e", "i", "i", "i", "i", "i", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", _
               "o", "o", "o", "o", "o", "u", "u", "u", "u", "u", "u", "u", "u", "u", "u", "u", "y", "y", "y", "y", "y", "A", "A", _
               "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "D", "E", "E", "E", "E", "E", "E", "E", _
               "E", "E", "E", "E", "I", "I", "I", "I", "I", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", _
               "O", "O", "O", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "Y", "Y", "Y", "Y", "Y")
                  
      For i = 1 To Len(UniText)
            inString = Mid(UniText, i, 1)
            If AscW(inString) >= 192 Then
                  For j = 0 To UBound(ArrUNI)
                        If AscW(inString) = ArrUNI(j) Then inString = ArrALP(j): Exit For
                  Next
            End If
            UniToKhongDau = UniToKhongDau + inString
      Next
                  
      Erase ArrUNI, ArrALP
End Function

Như vậy, hàm của Thầy giờ được chỉnh lại tí xíu:

Function NameLimit(ByVal Text As String, Length_Limit As Long) As String

      Dim Arr
      Dim tmp As String, tmpName As String
      Dim lPos As Long, [COLOR=#0000cd][B]LenStr [/B][/COLOR]As Long
      
      On Error Resume Next
      tmp = WorksheetFunction.Trim(Text)
      NameLimit = tmp
      If Len(tmp) > Length_Limit Then
            Arr = Split(tmp, " ")
            lPos = 1
            Do
                  Arr(lPos) = [COLOR=#ff0000][B]UniToKhongDau([/B][/COLOR]Left(Arr(lPos), 1)[B][COLOR=#ff0000])[/COLOR][/B]
                  tmpName = Join(Arr, " ")
                  LenStr = Len(tmpName)
                  lPos = lPos + 1
            Loop Until (LenStr <= Length_Limit Or lPos > UBound(Arr))
            NameLimit = tmpName
      End If
End Function

Cấu trúc vẫn không thay đổi: Áp dụng: =NameLimit(A1,20)

Riêng biến Length của Thầy em sửa lại là LenStr vì em ngại nó lại trùng với một thuộc tính nào đó của VBA.

 

[ndu96081631]

Hàm của Thầy thì quá tuyệt rồi, trường hợp tên quá dài theo em là hiếm, vì vậy nếu gặp phải thì đành phải tự sửa thủ công thôi. Tuy nhiên, với một yêu cầu của tác giả là những tên lót nguyên âm thì loại dấu tiếng Việt. Sau đây em sẽ thêm một hàm chuyển text ở font Unicode về dạng không dấu cho hàm của Thầy:

Hàm loại dấu tiếng Việt này tôi viết đã lâu:

Function RemoveMarks(ByVal Text As String) As String
  Dim CharCode, i As Long
  Dim ResText As String, sTmp As String
  On Error Resume Next
  sTmp = Text
  CharCode = Array(7855, 7857, 7859, 7861, 7863, 7845, 7847, 7849, 7851, 7853, 225, _
                   224, 7843, 227, 7841, 259, 226, 273, 7871, 7873, 7875, 7877, 7879, _
                   233, 232, 7867, 7869, 7865, 234, 237, 236, 7881, 297, 7883, 7889, _
                   7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907, 243, 242, _
                   7887, 245, 7885, 244, 417, 7913, 7915, 7917, 7919, 7921, 250, _
                   249, 7911, 361, 7909, 432, 253, 7923, 7927, 7929, 7925)
  ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
  For i = 0 To UBound(CharCode)
    sTmp = Replace(sTmp, ChrW(CharCode(i)), Mid(ResText, i + 1, 1))
    sTmp = Replace(sTmp, UCase(ChrW(CharCode(i))), UCase(Mid(ResText, i + 1, 1)))
  Next
  RemoveMarks = sTmp
End Function

Riêng biến Length của Thầy em sửa lại là LenStr vì em ngại nó lại trùng với một thuộc tính nào đó của VBA.

Không cần lo, nó chẳng trùng với bất cứ thứ gì đâu. Mà dù có trùng với THUỘC TÍNH gì gì đó cũng chẳng ăn nhậu gì cả
Ẹc... Ẹc...