Xin được giúp hàm xử lý mất khoảng trắng trong chuỗi ký tự (1 người xem)

[giaphuc2210]

Chào các Bác.

Em có 1 tập hợp nhiều chuỗi ký tự. Khi lấy về mất khoảng cách giữa các chữ không theo quy tắc nào cả.

Em xin nhờ các Bác trợ giúp hàm hoặc marco để chuyển đúng về định dạng.

E có file đính kèm.

Cảm ơn các Bác ạ.

 

[jack nt]

bớt đi thì dễ chứ thêm vào thì khó hơn. cứ thêm bừa đi (không khó lắm) rồi lại bớt đi (dễ hơn).

Option Explicit
 
Private Sub CommandButton1_Click()
    Dim MyRow&
    MyRow = 5
    Do Until Cells(MyRow, 2) = vbNullString
        Cells(MyRow, 3) = Trim2(convertABC(Cells(MyRow, 2)), " ")
        MyRow = MyRow + 1
    Loop
End Sub
 
Private Function convertABC(s$)
    Dim Ctrl As Control, Str$, StrFind$
    Str = s
    For Each Ctrl In UserForm1.Controls
        StrFind = Trim(Ctrl.Object.Text)
        If StrFind <> VbNullString then
             Str = Replace(Str, StrFind, StrFind & " ")
        End if
    Next
    convertABC = Str
End Function
 
Public Function Trim2$(s$, StrTrim$)
    Dim Str$
    Str = s
    Do Until InStr(1, Str, StrTrim & StrTrim, vbTextCompare) = 0
        Str = Replace(Str, StrTrim & StrTrim, StrTrim)
    Loop
    Trim2$ = Trim(Str)
End Function

trong file đính kèm có một userform có các text box chứa rời từng chữ, nếu cần xử lý thêm nữa thì cứ việc thêm vào...
nếu muốn phân biệt chữ hoa với chữ thường thì bỏ cái vbTextCompare đi.

 

[jack nt]

gởi bạn cách nữa.
cách 2 này tổng quát hơn, khỏi cần nhập từng từ vào userform1. tuy nhiên nó không xử lý 100% như cách 1 vì có thể có lỗi với từ nào đó chỉ xuất hiện 1 lần. Nếu số từ bạn đưa ví dụ là đủ (hoặc chỉ phải nhập thêm vài từ nữa) thì dùng cách trên. Nếu tổng số từ bị lỗi (không phải là số lần bị lỗi) là quá nhiều thì dùng cách này rồi làm cô tấm nhặt sạn vậy.

Option Explicit
 
Private Sub CommandButton1_Click()
    Dim a$(), aFind$(), ubFind&, i&, MyRow&
    MyRow = 5
    ubFind = -1
    Do Until Cells(MyRow, 2) = vbNullString
        a = Split(Cells(MyRow, 2), " ")
        For i = 0 To UBound(a)
            If Not isInAFind(a(i), aFind(), ubFind) Then
                ubFind = ubFind + 1
                ReDim Preserve aFind(ubFind)
                aFind(ubFind) = a(i)
            End If
        Next
        MyRow = MyRow + 1
    Loop
    MyRow = 5
    Do Until Cells(MyRow, 2) = vbNullString
        Cells(MyRow, 3) = Trim2(convertXYZ(Cells(MyRow, 2), aFind(), ubFind), " ")
        MyRow = MyRow + 1
    Loop
End Sub
 
Private Function isInAFind(s$, a$(), ub&) As Boolean
    Dim i&
    For i = 0 To ub
        If s = a(i) Then
            isInAFind = True
            Exit For
        End If
    Next
End Function
 
Private Function convertXYZ(s$, a$(), ub&)
    Dim i&, Str$, StrFind$
    Str = s
    For i = 0 To ub
        StrFind = Trim(a(i))
        Str = Replace(Str, StrFind, StrFind & " ")
    Next
    convertXYZ = Str
End Function
 
Public Function Trim2$(s$, StrTrim$)
    Dim Str$
    Str = s
    Do Until InStr(1, Str, StrTrim & StrTrim, vbTextCompare) = 0
        Str = Replace(Str, StrTrim & StrTrim, StrTrim)
    Loop
    Trim2$ = Trim(Str)
End Function