Đảo ngược chữ bằng VBA

Liên hệ QC
Thanh Bình PV

Thanh Bình PV

Thành viên hoạt động
Tham gia
30/10/19
Bài viết
151
Được thích
19
Em muốn đảo ngược chữ như ví dụ sau:
Ghost Touch by Alfred Dockstader ---> Alfred Dockstader - Ghost Touch
Secrets by Anthony Owens ---> Anthony Owens - Secrets
.....
Hiện tại thì em đang dùng hàm bên dưới để đảo ngược chúng.
Mã: 
=TRIM(MID(A4,FIND("by",A4)+2,LEN(A4)-FIND("by",A4)) & " - " &LEFT(A4,FIND("by",A4)-2))
Em có đọc qua bài viết "Xin hàm sắp xếp lại các thành phần của họ tên" và thấy bác NDU viết hàm để đảo ngược chữ rất hay và em muốn rút ngắn công thức bằng hàm tự tạo.
Em cũng thử nhưng lại không ra như ý muốn nên em đăng lên nhờ anh/chị giúp em với ạ.
Mã: 
'Ham doi Ghost Touch by Alfred Dockstader ---> Dockstader Alfred - Touch Ghost
Function Dao(Name As String) As String
  Dim Temp, i As Long
  Temp = Split(WorksheetFunction.Trim(Name), " ")
  For i = UBound(Temp) To 0 Step -1
    Dao = Trim(Dao & " " & Temp(i))
    Dao = Replace(Dao, "by", "-")
  Next
End Function
 

File đính kèm

  • GPE.xlsm
    15.2 KB · Đọc: 6
Text to Columns với phân cách là "by" rồi ghép 2 cột kết quả vào là xong, cho nó nhanh.
 
Thanh Bình PV đã viết:
Em muốn đảo ngược chữ như ví dụ sau:
Ghost Touch by Alfred Dockstader ---> Alfred Dockstader - Ghost Touch
Secrets by Anthony Owens ---> Anthony Owens - Secrets
Nhấp chuột vào đây để mở rộng...
Bạn muốn đảo lộn chuỗi, thử :
Mã: 
Function DaoLon(Name As String) As String
    DaoLon = Mid(Name & " - " & Name, InStr(1, Name, "by ") + 4, Len(Name) - 1)
End Function
 
phuocam đã viết:
Bạn muốn đảo lộn chuỗi, thử :
Mã: 
Function DaoLon(Name As String) As String
    DaoLon = Mid(Name & " - " & Name, InStr(1, Name, "by ") + 4, Len(Name) - 1)
End Function
Nhấp chuột vào đây để mở rộng...

Phải là
Mã: 
Function DaoLon(Name As String) As String
    DaoLon = Mid(Name & " - " & Name, InStr(1, Name, "by ") + 3, Len(Name) - 1)
End Function
 
Dưới đây là hàm đầy đủ Tham số để đảo chuỗi bạn có thể tham khảo.

Hàm WordReverseA vận dụng hàm InStr
Hàm WordReverseB vận dụng hàm Split
Hàm WordReverseE vận dụng Biểu thức chính quy

Với Hàm WordReverseE
Nếu gặp trường hợp sau thì kết quả luôn đúng

"Goodbye by Alfred Dockstader"

Mặc dù các hàm khác vẫn viết được như vậy nhưng vì tính phức tạp nên không nhất thiết.


-------------------
PHP: 
'' ÐaÒo chuôÞi theo ðiêÌu kiêòn vâòn duòng InStr
Function WordReverseA(ByVal ChuôÞi As String, _
            Optional ByVal PhânCách As String = " by ", _
            Optional ByVal ThayThêì As String = " - ", _
            Optional ByVal ViòTríTiÌm As Long = 1, _
            Optional ByVal CaÒHoaVàThýõÌng As Boolean = True) As String
  WordReverseA = ChuôÞi
  Dim I As Long, L As Long, L2 As Long
  L = Len(ChuôÞi): L2 = Len(PhânCách)
  I = VBA.InStr(ViòTríTiÌm, ChuôÞi, PhânCách, VBA.IIf(CaÒHoaVàThýõÌng, vbTextCompare, vbBinaryCompare))
  If I + L2 - 1 < L And I > 1 Then
    WordReverseA = VBA.Mid(ChuôÞi, I + L2) & ThayThêì & VBA.Left(ChuôÞi, I - 1)
  End If
End Function
'' ÐaÒo chuôÞi theo ðiêÌu kiêòn vâòn duòng Hàm Split
Function WordReverseB(ByVal ChuôÞi As String, _
             Optional ByVal PhânCách As String = " by ", _
             Optional ByVal ThayThêì As String = " - ", _
             Optional ByVal ViòTríTiÌm As Long = 1, _
             Optional ByVal CaÒHoaVàThýõÌng As Boolean = True) As String
  WordReverseB = ChuôÞi
  If ViòTríTiÌm > 1 Then
    ChuôÞi = VBA.Mid(ChuôÞi, ViòTríTiÌm)
  End If
  On Error GoTo Ends
  Dim SP$()
  SP = VBA.Split(ChuôÞi, PhânCách, -1, VBA.IIf(CaÒHoaVàThýõÌng, vbTextCompare, vbBinaryCompare))
  If UBound(SP) = 1 Then
    WordReverseB = SP(1) & ThayThêì & SP(0)
  End If
Ends: On Error GoTo 0
End Function

'' ÐaÒo chuôÞi theo ðiêÌu kiêòn vâòn duòng
'' BiêÒu thýìc chính quy (Regular Expression)
Function WordReverseE(ByVal ChuôÞi As String, _
              Optional ByVal PhânCách As String = " by ", _
              Optional ByVal ThayThêì As String = " - ", _
              Optional ByVal ViòTríTiÌm As Long = 1, _
              Optional ByVal CaÒHoaVàThýõÌng As Boolean = True) As String
  On Error GoTo Ends
  WordReverseE = ChuôÞi
  If ViòTríTiÌm > 1 Then
    ChuôÞi = VBA.Mid(ChuôÞi, ViòTríTiÌm)
  End If
  Static RE As Object
  If RE Is Nothing Then
    Set RE = VBA.CreateObject("VBScript.RegExp")
  End If
  With RE
    .Global = 1: .MultiLine = 0: .ignoreCase = CaÒHoaVàThýõÌng
    .Pattern = "([\\\?\+\*\[\]\$\^\=\-\{\}\(\)\:\.\|])"
    PhânCách = .Replace(PhânCách, "\$1")
    .Global = 0
    .Pattern = "(.+)\b" & PhânCách & "\b(.+)"
    WordReverseE = .Replace(ChuôÞi, "$2" & ThayThêì & "$1")
  End With
Ends: On Error GoTo 0
End Function
 
Lần chỉnh sửa cuối:
Tôi thấy thế này cũng đúng với nhiều trường hợp.
Mã: 
Function DaoDoanVan(xCell As String) As String
    DaoDoanVan = Mid(xCell & " - " & xCell, InStr(1, xCell, " by ") + 3, Len(xCell))
End Function
 
HeSanbi đã viết:
Dưới đây là hàm đầy đủ Tham số để đảo chuỗi bạn có thể tham khảo.

Hàm WordReverseA vận dụng hàm InStr
Hàm WordReverseB vận dụng hàm Split
Hàm WordReverseE vận dụng Biểu thức chính quy

Với Hàm WordReverseE
Nếu gặp trường hợp sau thì kết quả luôn đúng

"Goodbye by Alfred Dockstader"

Mặc dù các hàm khác vẫn viết được như vậy nhưng vì tính phức tạp nên không nhất thiết.
-------------------
Nhấp chuột vào đây để mở rộng...
Em đã thử dùng cả 3 hàm của anh nhưng mà cả 3 hàm đều không đổi vị trí của chuỗi ạ.

XuanThanh đã viết:
Phải là
Mã: 
Function DaoLon(Name As String) As String
    DaoLon = Mid(Name & " - " & Name, InStr(1, Name, "by ") + 3, Len(Name) - 1)
End Function
Nhấp chuột vào đây để mở rộng...
Em cảm ơn ạ. Hàm sử dụng tốt ạ.

be09 đã viết:
Tôi thấy thế này cũng đúng với nhiều trường hợp.
Mã: 
Function DaoDoanVan(xCell As String) As String
    DaoDoanVan = Mid(xCell & " - " & xCell, InStr(1, xCell, " by ") + 3, Len(xCell))
End Function
Nhấp chuột vào đây để mở rộng...
Em nghĩ là "InStr(1, xCell, " by ") + 4" thì sẽ không có khoảng trắng ở đầu chuỗi.

Em chưa gặp trường hợp này nhưng giả dụ thêm trường hợp là không có khoảng trắng ở ngay chữ "by" ( 1 số chữ sẽ có từ "by" bên trong như anh HeSanbi nói ở bài #5) hoặc chữ "by_" có ký tự đặc biệt("_","-","/",...) thì mình viết hàm sao ạ.

Ghosbyt TouchbyAlfred Dockstader
Ghost TouchbyAlfred Dockstader
Ghost Touchby_Alfred Dockstader
 
Lần chỉnh sửa cuối:
Thanh Bình PV đã viết:
Em đã thử dùng cả 3 hàm của anh nhưng mà cả 3 hàm đều không đổi vị trí của chuỗi ạ.


Em cảm ơn ạ. Hàm sử dụng tốt ạ.


Em nghĩ là "InStr(1, xCell, " by ") + 4" thì sẽ không có khoảng trắng ở đầu chuỗi.

Em chưa gặp trường hợp này nhưng giả dụ thêm trường hợp là không có khoảng trắng ở ngay chữ "by" ( 1 số chữ sẽ có từ "by" bên trong như anh HeSanbi nói ở bài #5) hoặc chữ "by_" có ký tự đặc biệt("_","-","/",...) thì mình viết hàm sao ạ.

Ghosbyt TouchbyAlfred Dockstader
Ghost TouchbyAlfred Dockstader
Ghost Touchby_Alfred Dockstader
Nhấp chuột vào đây để mở rộng...

---------------

Bạn copy một lần nữa xem lại, tôi viết code không kiểm tra, hơi chủ quan.
 
Thanh Bình PV đã viết:
Em muốn đảo ngược chữ như ví dụ sau:
Ghost Touch by Alfred Dockstader ---> Alfred Dockstader - Ghost Touch
Secrets by Anthony Owens ---> Anthony Owens - Secrets
.....
Hiện tại thì em đang dùng hàm bên dưới để đảo ngược chúng.
Mã: 
=TRIM(MID(A4,FIND("by",A4)+2,LEN(A4)-FIND("by",A4)) & " - " &LEFT(A4,FIND("by",A4)-2))
Em có đọc qua bài viết "Xin hàm sắp xếp lại các thành phần của họ tên" và thấy bác NDU viết hàm để đảo ngược chữ rất hay và em muốn rút ngắn công thức bằng hàm tự tạo.
Em cũng thử nhưng lại không ra như ý muốn nên em đăng lên nhờ anh/chị giúp em với ạ.
Mã: 
'Ham doi Ghost Touch by Alfred Dockstader ---> Dockstader Alfred - Touch Ghost
Function Dao(Name As String) As String
  Dim Temp, i As Long
  Temp = Split(WorksheetFunction.Trim(Name), " ")
  For i = UBound(Temp) To 0 Step -1
    Dao = Trim(Dao & " " & Temp(i))
    Dao = Replace(Dao, "by", "-")
  Next
End Function
Nhấp chuột vào đây để mở rộng...
Thử viết "xàm" như vầy:
Mã: 
Function SenReverse(ByVal Text As String, Optional ByVal Delimiter As String = " ", Optional ByVal NewDelimiter As String = " ") As String
  Dim Temp, iC, iR
  On Error Resume Next
  Text = WorksheetFunction.Trim(Text)
  iC = UBound(Split(Text, Delimiter)) + 1
  iR = "ROW(1:" & iC & ")"
  Text = "{""" & Replace(Text, "" & Delimiter & "", """,""") & """}"
  Temp = "Lookup(" & iC + 1 & "-" & iR & "," & iR & "," & Text & ")"
  SenReverse = Join(Evaluate("Transpose(" & Temp & ")"), NewDelimiter)
End Function
Giả sử dữ liệu của bạn ở cột A, công thức tại cột B sẽ là:
Mã: 
=SenReverse(A1, " by ", " - ")
Viết "xàm xàm" chơi thôi, thấy ưng ý thì xài, không thì xem như tham khảo...
 

File đính kèm

  • DaoCau.xlsm
    19.6 KB · Đọc: 4
HeSanbi đã viết:
---------------
Bạn copy một lần nữa xem lại, tôi viết code không kiểm tra, hơi chủ quan.
Nhấp chuột vào đây để mở rộng...
Hoạt động tốt rồi ạ.

ndu96081631 đã viết:
Thử viết "xàm" như vầy:
Mã: 
Function SenReverse(ByVal Text As String, Optional ByVal Delimiter As String = " ", Optional ByVal NewDelimiter As String = " ") As String
  Dim Temp, iC, iR
  On Error Resume Next
  Text = WorksheetFunction.Trim(Text)
  iC = UBound(Split(Text, Delimiter)) + 1
  iR = "ROW(1:" & iC & ")"
  Text = "{""" & Replace(Text, "" & Delimiter & "", """,""") & """}"
  Temp = "Lookup(" & iC + 1 & "-" & iR & "," & iR & "," & Text & ")"
  SenReverse = Join(Evaluate("Transpose(" & Temp & ")"), NewDelimiter)
End Function
Giả sử dữ liệu của bạn ở cột A, công thức tại cột B sẽ là:
Mã: 
=SenReverse(A1, " by ", " - ")
Viết "xàm xàm" chơi thôi, thấy ưng ý thì xài, không thì xem như tham khảo...
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh đã quan tâm ạ.
 
HeSanbi đã viết:
---------------

Bạn copy một lần nữa xem lại, tôi viết code không kiểm tra, hơi chủ quan.
Nhấp chuột vào đây để mở rộng...
Anh có thể chỉnh giúp em được không ạ. Sau khi sử dụng thì em gặp phải 2 trường hợp không ra được kết quả như ý :
Trường hợp 1 : Ghost Touch BY Alfred Dockstader
Trường hợp 2 : Ghost Touch (EMS) by Alfred Dockstader
 
Thanh Bình PV đã viết:
Anh có thể chỉnh giúp em được không ạ. Sau khi sử dụng thì em gặp phải 2 trường hợp không ra được kết quả như ý :
Trường hợp 1 : Ghost Touch BY Alfred Dockstader
Trường hợp 2 : Ghost Touch (EMS) by Alfred Dockstader
Nhấp chuột vào đây để mở rộng...
Nếu bạn sử dụng hàm A thì sửa lại Optional Byval CảHoaVàThường As Boolean = True , vì tôi đã quên sửa nó lúc đầu. (Hoặc copy lại)
 
Lần chỉnh sửa cuối:
Tôi chưa thử hàm nào.
Nhưng cho tới giờ phút này, tôi chưa thấy thớt ngờ đến trường hợp "tên quyển sách có từ by bên trong"
ví dụ: Killed by Mistake, Win by a Nose

Thớt cần xác định: nếu có nhiều từ "by" thì có phải từ cuối cùng mới chính là từ ngăn cách tên sách và tác giả.
 
VetMini đã viết:
Tôi chưa thử hàm nào.
Nhưng cho tới giờ phút này, tôi chưa thấy thớt ngờ đến trường hợp "tên quyển sách có từ by bên trong"
ví dụ: Killed by Mistake, Win by a Nose

Thớt cần xác định: nếu có nhiều từ "by" thì có phải từ cuối cùng mới chính là từ ngăn cách tên sách và tác giả.
Nhấp chuột vào đây để mở rộng...
Dạ vâng. Lúc đầu em cũng chưa nghĩ tới vấn đề đó vì có quá nhiều File nên em không kiểm soát nổi. Và vấn đề đó cũng được anh HeSanbi nhắc đến trong bài #5, nên em cũng đang sài hàm của anh ấy.
Nhưng vẫn còn 1 số trường hợp em không ngờ tới như : Haunted IllusionsbyPaul Osborne, Jinxed_Readings_by_Peter_Turner,
Little Black Book by Richard Nongard by Rick Lax, ... Nhưng chỉ là số ít nên em có thể sửa tay được, hy vọng sẽ không gặp những File đó nhiều.

HeSanbi đã viết:
Nếu bạn sử dụng hàm A thì sửa lại Optional Byval CảHoaVàThường As Boolean = True , vì tôi đã quên sửa nó lúc đầu. (Hoặc copy lại)
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh ạ.
Trường hợp 1 : Ghost Touch BY Alfred Dockstader (Hàm WordReverseA và WordReverseB và WordReverseE chạy tốt)
Trường hợp 2 : Ghost Touch (EMS) by Alfred Dockstader (chỉ hàm WordReverseA và WordReverseB chạy tốt)
 
Thanh Bình PV đã viết:
Dạ vâng. Lúc đầu em cũng chưa nghĩ tới vấn đề đó vì có quá nhiều File nên em không kiểm soát nổi. Và vấn đề đó cũng được anh HeSanbi nhắc đến trong bài #5, nên em cũng đang sài hàm của anh ấy.
Nhưng vẫn còn 1 số trường hợp em không ngờ tới như : Haunted IllusionsbyPaul Osborne, Jinxed_Readings_by_Peter_Turner,
Little Black Book by Richard Nongard by Rick Lax, ... Nhưng chỉ là số ít nên em có thể sửa tay được, hy vọng sẽ không gặp những File đó nhiều.


Cảm ơn anh ạ.
Trường hợp 1 : Ghost Touch BY Alfred Dockstader (Hàm WordReverseA và WordReverseB và WordReverseE chạy tốt)
Trường hợp 2 : Ghost Touch (EMS) by Alfred Dockstader (chỉ hàm WordReverseA và WordReverseB chạy tốt)
Nhấp chuột vào đây để mở rộng...
----------------------


Bạn sửa lại đoạn:
"(.+?)" & PhânCách & "(.+)"

hai từ "by" trong một chuỗi thì sẽ tách từ đầu tiên.

Thêm đoạn này vào trên đoạn On Error GoTo Ends của hàm:

PhânCách = VBA.Replace(PhânCách, "_by_", " by ", , ,1)
PhânCách = VBA.Replace(PhânCách, "by_", " by ", , ,1)

Để không phải xóa tay.
 
Tưởng rắc rối thì mới phải cốt kiếc tùm lum chứ chấp nhận sửa tay ba cái chỗ khó thì dùng PowerQuery là được gần hết (sửa tay chỗ còn lại).
Nếu làm được bằng PowerQuery thì ADO cũng khá gọn.

Còn muốn rắc rối thì từ đầu phải ước tính độ phức tạp của dữ liệu. Sau đó tính cách giải quyết các trường hợp.
Điển hình, đoán các tường hợp có thể xảy ra:
1. nhiều hơn 1 " by "
2. không có " by " mà chỉ có _by_; -by-
3. không có " by " nhưng có "*by*"
4. ...
Kế dó lập một bảng chân lý (truth table) theo thứ tự ưu tiên:
1. ưu tiên cho " by " đơn giản
2. nếu có nhiều hơn 1 " by " thì chọn cái cuối cùng
3. không có " by " thì thử "_by_" và "-by-"
4. không có cả thì thử "*by*"
5. các chước khác
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

LuuAnh980
Vấn đề viết tắt trong Diễn Đàn.
    • Thích
    • Cười
2
Trả lời
32
Đọc
391
NCSCVN
NCSCVN
L
Tạo hàm Round cho nhiều dòng
Trả lời
14
Đọc
6K
KenJayce
K
N
Giải pháp nào để gỡ bỏ hàm Round (là hàm ngoài cùng) trong tất cả các ô trong bảng?
Trả lời
8
Đọc
4K
KenJayce
K
T
Tổng hợp từ Sheet1 qua Sheet2
Trả lời
7
Đọc
118
thaiquy7
T
ann266
Kế toán kho F&B
    • Cười
2
Trả lời
22
Đọc
258
le_vis
L
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom