Public Sub Ma_Hoa_Ten_Sach()
Dim DL, MaVan, XoaDau, PhuAm, Tam, kq(), r As Long, rw As Long,c As Long, i
DL = Sheet2.Range("A2", Sheet2.Range("A65000").End(xlUp))
MaVan = Sheet1.Range("A1").CurrentRegion
XoaDau = Sheet1.Range("D1").CurrentRegion
PhuAm = Sheet1.Range("G1").CurrentRegion
ReDim kq(1 To UBound(DL), 5)
'Xoa dau, tach tu
For r = 1 To UBound(DL)
Tam = Split(LCase(DL(r, 1)) & " ", " ")
DL(r, 1) = Tam(0) & " " & Tam(1)
For c = 1 To Len(DL(r, 1))
For rw = 1 To UBound(XoaDau)
If Mid(DL(r, 1), c, 1) = XoaDau(rw, 1) Then
Mid(DL(r, 1), c, 1) = XoaDau(rw, 2)
End If
Next rw
Next c
Tam = Split(DL(r, 1), " ")
kq(r, 4) = Tam(0): kq(r, 5) = Tam(1)
Next r
'Tach PhuAm va Van. Nap ma so
With CreateObject("VBScript.RegExp")
For r = 1 To UBound(kq)
'Tách từ thứ 1
i = 0
For rw = 1 To UBound(PhuAm)
.Pattern = "^" & PhuAm(rw, 1)
If .test(kq(r, 4)) Then
If i < Len(.Execute(kq(r, 4))(0)) Then
i = Len(.Execute(kq(r, 4))(0))
End If
End If
Next rw
If i = 0 Then
kq(r, 1) = Left(kq(r, 4), 1): kq(r, 2) = kq(r, 4)
Else
kq(r, 1) = Left(kq(r, 4), i)
kq(r, 2) = Right(kq(r, 4), Len(kq(r, 4)) - i)
End If
'Tách từ thứ 2
i = 0
For rw = 1 To UBound(PhuAm)
.Pattern = "^" & PhuAm(rw, 1)
If .test(kq(r, 5)) Then
If i < Len(.Execute(kq(r, 5))(0)) Then
i = Len(.Execute(kq(r, 5))(0))
End If
End If
Next rw
If i = 0 Then
kq(r, 3) = Left(kq(r, 5), 1)
Else
kq(r, 3) = Left(kq(r, 5), i)
End If
'Nạp mã số vần
For rw = 1 To UBound(MaVan)
If kq(r, 2) = MaVan(rw, 1) Then kq(r, 2) = MaVan(rw, 2): Exit For
Next rw
'Kiểm tra lại mã số vần
'nếu không phải là số thì ghép thêm từ của phụ âm trước và nạp lại ( Chữ gi )
If IsNumeric(kq(r, 2)) = False Then
For rw = 1 To UBound(MaVan)
If Right(kq(r, 1), 1) & kq(r, 2) = MaVan(rw, 1) Then kq(r, 2) = MaVan(rw, 2): Exit For
Next rw
End If
kq(r, 0) = UCase(kq(r, 1) & kq(r, 2) & kq(r, 3))
Next r
End With
Sheet2.Range("B2").End(xlDown).ClearContents
Sheet2.Range("B2").Resize(UBound(DL), 1).Value = kq
End Sub
