Chuẩn hoá định dạng email có đuôi gmail.com (2 người xem)

[8589934592]

Mình đang có một danh sách email chưa được chuẩn hoá định dạng email (xem trong file đính kèm). Trong file mình đã mô tả lỗi cụ thể của từng email.
Các bạn giúp mình lập một Function trong VBA để giải quyết bài toán chuẩn hoá này.
Xin cảm ơn các bạn đã giúp đỡ.

 

[Hoàng Tuấn 868]

lập một Function trong VBA

Vậy thì bạn đăng nhầm chuyên mục rồi.

 

[Maika8008]

Mình đang có một danh sách email chưa được chuẩn hoá định dạng email (xem trong file đính kèm). Trong file mình đã mô tả lỗi cụ thể của từng email.
Các bạn giúp mình lập một Function trong VBA để giải quyết bài toán chuẩn hoá này.
Xin cảm ơn các bạn đã giúp đỡ.

Chờ mod dời bài đúng box và hóng giải thuật.

 

[huuthang_bd]

Các trường hợp được coi là lỗi và đã xử lý trong code:

1. Chứa ký tự không hợp lệ
2. Nhiều dấu chấm liên tiếp
3. Thiếu @
4. Đảo 2 ký tự trong tên miền
5. Sai 1 ký tự trong tên miền
6. Thiếu 1 ký tự trong tên miền
7. Tên miền dư .xx

Option Compare Text
Function ChuanHoaEmail(ByVal sDiaChiMail As String, Optional ByVal sTenMien As String = "@gmail.com", Optional ByVal sKyTuKhongHopLe As String = " /\<>&=-',<>") As String
Dim i As Long, sLoi As String
sDiaChiMail = Replace(sDiaChiMail, " ", "")
For i = 1 To Len(sKyTuKhongHopLe)
    sDiaChiMail = Replace(sDiaChiMail, Mid(sKyTuKhongHopLe, i, 1), "")
Next
'xoa ..
While InStr(sDiaChiMail, "..") > 0
    sDiaChiMail = Replace(sDiaChiMail, "..", ".")
Wend
i = InStrRev(sDiaChiMail, "@")
If i = 0 Then
    'Thieu @
    If KiemTra(sDiaChiMail, sTenMien, Mid(sTenMien, 2)) Then GoTo KetQua
Else
    'Xoa @ khong hop le
    sDiaChiMail = Replace(Left(sDiaChiMail, i - 1), "@", "") & Mid(sDiaChiMail, i)
End If
For i = 2 To Len(sTenMien)
    'Dao ky tu
    sLoi = sTenMien
    Mid(sLoi, i, 2) = VBA.StrReverse(Mid(sLoi, i, 2))
    If KiemTra(sDiaChiMail, sTenMien, sLoi) Then GoTo KetQua
    'Sai 1 ky tu
    sLoi = sTenMien
    Mid(sLoi, i, 1) = "?"
    If KiemTra(sDiaChiMail, sTenMien, sLoi) Then GoTo KetQua
    'Thieu 1 ky tu
    sLoi = Left(sTenMien, i - 1) & Mid(sTenMien, i + 1)
    If KiemTra(sDiaChiMail, sTenMien, sLoi) Then GoTo KetQua
Next
'Du duoi .xx
If sDiaChiMail Like "*" & sTenMien & ".*" Then
    sDiaChiMail = Left(sDiaChiMail, InStr(sDiaChiMail, sTenMien) - 1) & sTenMien
End If
KetQua:
ChuanHoaEmail = sDiaChiMail
End Function
Private Function KiemTra(ByRef sDiaChiMail As String, ByRef sTenMien As String, ByVal sLoi As String) As Boolean
    If sDiaChiMail Like "*" & sLoi Then
        sDiaChiMail = Left(sDiaChiMail, Len(sDiaChiMail) - Len(sLoi)) & sTenMien
        KiemTra = True
    End If
End Function