Tìm và trả về đoạn text có chứa ký tự cho trước

[Po_Pikachu]

Xin góp vui với UDF:

Function Tachmail(cel As String) As String  '' Po_PiKachu     On Error Resume Next     Dim arr() As String     If cel = "" Or IsNull(cel) Then Tachmail = "Error": Exit Function     arr() = Split(cel, " ")          For i = 0 To UBound(arr)         If InStr(1, arr(i), "@")  0 Then             Tachmail = arr(i)             Exit Function         End If     Next End Function

Thân.

 

[Po_Pikachu]

Hoặc không cần For luôn.

Function Tachmail(cel As String) As String  '' Po_PiKachu Dim arr() As String, mng() As String, mang() As String If cel = "" Or IsNull(cel) Then Tachmail = "Error": Exit Function mang() = Split(cel, "@") mng() = Split(mang(0), " ") arr() = Split(mang(1), " ")   Tachmail = Mid(cel, InStr(1, cel, mng(UBound(mng()))), _         Len(mng(UBound(mng()))) + Len(arr(0)) + 1) End Function

Thân.

 

[ndu96081631]

Tôi vừa tình cờ thấy có 1 người có cách giải bài này theo 1 cách khác, xin được đưa lên đây mọi người cùng tham khảo. Cách này tôi thấy không bị hạn chế về độ dài của email, không phải thay thế dấu cách.

Cách làm rất hay... nhưng như tôi đã nói: Dùng For thì ăn chắc sẽ không nhanh ---> ROW(INDIRECT(....) )) thì hoàn toàn tương đương với For
Còn nếu dùng UDF thì tôi cũng sẽ bám vào thuật toán tôi miêu tả ở trên

Function ExtractEmail(Chuoi As String) As String
  Dim Temp As String
  If InStr(Chuoi, "@") Then
    Temp = Replace(" " & Chuoi & " ", " ", Space(255))
    ExtractEmail = Trim(Mid(Temp, InStr(Temp, "@") - 255, 510))
  End If
End Function

Khỏi For phiếc gì ráo

 

[rollover79]

Cách làm rất hay... nhưng như tôi đã nói: Dùng For thì ăn chắc sẽ không nhanh ---> ROW(INDIRECT(....) )) thì hoàn toàn tương đương với For
Còn nếu dùng UDF thì tôi cũng sẽ bám vào thuật toán tôi miêu tả ở trên

Function ExtractEmail(Chuoi As String) As String
  Dim Temp As String
  If InStr(Chuoi, "@") Then
    Temp = Replace(" " & Chuoi & " ", " ", Space(255))
    ExtractEmail = Trim(Mid(Temp, InStr(Temp, "@") - 255, 510))
  End If
End Function

Khỏi For phiếc gì ráo

Tốc độ thì có thể không nhanh bằng, nhưng như tôi đã có giải thích là nó không bị hạn chế bởi độ dài của email nên luôn trả về kết quả đúng. Còn nếu đã dùng VBA thì đúng là bài này không cần phải for, nhưng cũng không nên làm theo thuật toán này, vì đã dùng đến VBA thì phải trả về đúng cho mọi trường hợp chứ nhỉ. Xin góp 1 code như sau:

Function GetEmail(email As String) As String
    If InStr(1, email, "@") = 0 Then Exit Function
    email = " " & email & " "
    GetEmail = Trim(Mid(email, InStrRev(email, " ", InStr(1, email, "@")), InStr(InStr(1, email, "@"), email, " ") - InStrRev(email, " ", InStr(1, email, "@"))))
End Function

 

[ndu96081631]

Tốc độ thì có thể không nhanh bằng, nhưng như tôi đã có giải thích là nó không bị hạn chế bởi độ dài của email nên luôn trả về kết quả đúng. Còn nếu đã dùng VBA thì đúng là bài này không cần phải for, nhưng cũng không nên làm theo thuật toán này, vì đã dùng đến VBA thì phải trả về đúng cho mọi trường hợp chứ nhỉ. Xin góp 1 code như sau:

Function GetEmail(email As String) As String
    If InStr(1, email, "@") = 0 Then Exit Function
    email = " " & email & " "
    GetEmail = Trim(Mid(email, InStrRev(email, " ", InStr(1, email, "@")), InStr(InStr(1, email, "@"), email, " ") - InStrRev(email, " ", InStr(1, email, "@"))))
End Function

Cũng hay... nhưng vẫn... dài...
Ẹc... Ẹc...
Nếu tôi thay số 255 trong code của tôi thành Len(Chuoi) thì bạn nghĩ sao?
Tức số lượng ký tự rỗng đưa vào là "Động" ---> Phụ thuộc vào độ dài chuổi
Vậy ổn chứ ---> Email có chiều dài bao nhiêu cũng khỏi lo

Function ExtractEmail(Chuoi As String) As String
  Dim Temp As String
  If InStr(Chuoi, "@") Then
    Temp = Replace(" " & Chuoi & " ", " ", Space(Len(Chuoi)))
    ExtractEmail = Trim(Mid(Temp, InStr(Temp, "@") - Len(Chuoi), 2 * Len(Chuoi)))
  End If
End Function