Xử lý chuỗi bằng code VBA

[axa00000019]

Nhờ các Anh/ chị giúp đỡ.
Hiện em đang có 1 file dữ liệu, em không muốn dùng công thức mà muốn thực hiện bằng code VBA.
Mục tiêu mong muốn em có note trong file.
Mong các anh chị giúp đỡ 1 đoạn code tối ưu hóa vấn đề.
Xin cảm ơn!

 

[befaint]

không muốn dùng công thức

Mình gửi công thức đã làm đó lên đây xem nào.

 

[batman1]

Lưu ý:
1. Thêm Module1 và dán code ở dưới.
2. Code giả thiết là dữ liệu ở cột A và bắt đầu từ dòng 1, còn kết quả ở cột B. Nếu khác thì sửa code.
3. Code giả thiết là dữ liệu ở sheet1, nếu ở sheet khác thì sửa trong code "Sheet1" thành tên hiện hành. Nếu code luôn chạy cho sheet đang hoạt động, bất luận ở thời điểm chạy code sheet đó có tên là gì, thì thay ThisWorkbook.Worksheets("Sheet1") ở 2 chỗ thành ActiveSheet
4. code chỉ bỏ "Thay" ở đầu, không bỏ "thay" ở những vị trí khác nếu có.

Sub rut_gon()
Dim lastRow As Long, r As Long, text As String, dulieu()
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        .Range("B1:B" & lastRow).ClearContents  ' xoa ket qua cu
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        dulieu = .Range("A1:A" & lastRow + 1).Value ' lay du 1 dong cuoi cung
    End With
    For r = 1 To UBound(dulieu, 1) - 1  ' khong xet dong lay du
        text = dulieu(r, 1)
        If InStr(1, text, "thay ", vbTextCompare) = 1 Then text = Trim(Mid(text, 5))
        Mid(text, 1, 1) = UCase(Mid(text, 1, 1))
        text = Replace(text, "Tr" & ChrW(225) & "i", "T", , , vbTextCompare)
        text = Replace(text, "Ph" & ChrW(7843) & "i", "P", , , vbTextCompare)
        dulieu(r, 1) = text
    Next r
    ThisWorkbook.Worksheets("Sheet1").Range("B1:B" & lastRow).Value = dulieu
End Sub

 

[axa00000019]

Lưu ý:
1. Thêm Module1 và dán code ở dưới.
2. Code giả thiết là dữ liệu ở cột A và bắt đầu từ dòng 1, còn kết quả ở cột B. Nếu khác thì sửa code.
3. Code giả thiết là dữ liệu ở sheet1, nếu ở sheet khác thì sửa trong code "Sheet1" thành tên hiện hành. Nếu code luôn chạy cho sheet đang hoạt động, bất luận ở thời điểm chạy code sheet đó có tên là gì, thì thay ThisWorkbook.Worksheets("Sheet1") ở 2 chỗ thành ActiveSheet
4. code chỉ bỏ "Thay" ở đầu, không bỏ "thay" ở những vị trí khác nếu có.

Sub rut_gon()
Dim lastRow As Long, r As Long, text As String, dulieu()
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        .Range("B1:B" & lastRow).ClearContents  ' xoa ket qua cu
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        dulieu = .Range("A1:A" & lastRow + 1).Value ' lay du 1 dong cuoi cung
    End With
    For r = 1 To UBound(dulieu, 1) - 1  ' khong xet dong lay du
        text = dulieu(r, 1)
        If InStr(1, text, "thay ", vbTextCompare) = 1 Then text = Trim(Mid(text, 5))
        Mid(text, 1, 1) = UCase(Mid(text, 1, 1))
        text = Replace(text, "Tr" & ChrW(225) & "i", "T", , , vbTextCompare)
        text = Replace(text, "Ph" & ChrW(7843) & "i", "P", , , vbTextCompare)
        dulieu(r, 1) = text
    Next r
    ThisWorkbook.Worksheets("Sheet1").Range("B1:B" & lastRow).Value = dulieu
End Sub

Rất cảm ơn. Code chạy rất ổn ạ.
Em muốn làm 1 cái Addins để dùng cho vùng dữ liệu được chọn thì Code sẽ như thế nào. Mong Anh giúp ạ.

 

[batman1]

Rất cảm ơn. Code chạy rất ổn ạ.
Em muốn làm 1 cái Addins để dùng cho vùng dữ liệu được chọn thì Code sẽ như thế nào.

Hãy thử tập tin đính kèm (XLAM).
Thẻ "Thay thế" được tạo sau thẻ Home. Đưa chuột vào nút Rút gọn để xem hướng dẫn cách dùng (Chọn vùng trong 1 cột trên sheet rồi nhấn nút Rút gọn trên Ribbon).

Kết quả sẽ được nhập ở cột bên phải vùng chọn.

 

[axa00000019]

Hãy thử tập tin đính kèm (XLAM).
Thẻ "Thay thế" được tạo sau thẻ Home. Đưa chuột vào nút Rút gọn để xem hướng dẫn cách dùng (Chọn vùng trong 1 cột trên sheet rồi nhấn nút Rút gọn trên Ribbon).

Kết quả sẽ được nhập ở cột bên phải vùng chọn.

Chạy ổn. Rất cảm ơn Anh.!