giúp em hàm bóc tách dữ liệu ạ

[phulien1902]

cảm ơn anh!

Bài đã được tự động gộp: 20/6/18

ở sheet1 lọc trong chuỗi địa chỉ mail chỉ lấy đoạn từ đuôi tên miền trang web đến dấu chấm ạ
vd: tuan.phamhoa.vn@gmail.com, thì chỉ lọc lấy kết quả là phamhoa.vn
trong file vd em có mô tả kết quả kĩ anh
anh xem chỉnh lại code giúp e với ạ !

Bạn phải kêu nhà sản xuất chứ? Tôi có biết gì đâu mà chỉnh với sửa?

 

[excel_lv1.5]

cảm ơn anh!

Bài đã được tự động gộp: 20/6/18

ở sheet1 lọc trong chuỗi địa chỉ mail chỉ lấy đoạn từ đuôi tên miền trang web đến dấu chấm ạ
vd: tuan.phamhoa.vn@gmail.com, thì chỉ lọc lấy kết quả là phamhoa.vn
trong file vd em có mô tả kết quả kĩ anh
anh xem chỉnh lại code giúp e với ạ !

Bạn chỉnh code lại như vầy:

Function tach(str As String, Optional n As Long = 1) As String
Dim result()
result = Array(".com.vn", ".org.vn", ".net.vn", ".com", ".net", ".org", ".info", ".biz", ".vn")
With CreateObject("vbscript.regexp")
    .Global = True
    If n = 3 Then
        .Pattern = "(www.)?([a-zA-Z0-9.-]+)([^a-zA-Z0-9.-]{1,2})?<"
    Else
        .Pattern = "([a-zA-Z0-9]+(" + Join(result, "|") + ")).*(@.+)"
    End If
    If .test(str) Then
        Select Case n
            Case 1
                tach = .Execute(str)(0).submatches(0)
            Case 2
                tach = .Execute(str)(0).submatches(2)
            Case 3
                tach = .Execute(str)(0).submatches(1)
        End Select
    End If
End With
End Function

 

[lala_qn]

Bạn chỉnh code lại như vầy:

Function tach(str As String, Optional n As Long = 1) As String
Dim result()
result = Array(".com.vn", ".org.vn", ".net.vn", ".com", ".net", ".org", ".info", ".biz", ".vn")
With CreateObject("vbscript.regexp")
    .Global = True
    If n = 3 Then
        .Pattern = "(www.)?([a-zA-Z0-9.-]+)([^a-zA-Z0-9.-]{1,2})?<"
    Else
        .Pattern = "([a-zA-Z0-9]+(" + Join(result, "|") + ")).*(@.+)"
    End If
    If .test(str) Then
        Select Case n
            Case 1
                tach = .Execute(str)(0).submatches(0)
            Case 2
                tach = .Execute(str)(0).submatches(2)
            Case 3
                tach = .Execute(str)(0).submatches(1)
        End Select
    End If
End With
End Function

dạ em chạy thử thì thấy còn lỗi như sau ạ
- ở sheet1 còn lỗi như sau
vd dữ liệu: anhvietvn@gmail.com thì kết quả là anhvietvn
vd dữ liệu: letuan_com@yahoo.com ra kết quả là letuan_com
2 dạng này em ko cần ra kết quả, nhờ anh chỉnh code loại bỏ 2 dạng này với ạ

- ở sheet2 còn lỗi như sau
vd dữ liệu: anh Tuấn <anhtuan@gmail.com> ra kết quả là n , cái này nếu đúng sẽ ko có kết quả
vd dữ liệu: "Phương -www.lephuong.com" <lephuong@gmail.com> ra kết quả là -www.lephuong.com, em cần kết quả đúng là lephuong.com
vd dữ liệu: Phú -phamphu.com <phamphu@gmail.com> ra kết quả là -phamphu.com , em cần kết quả đúng là phamphu.com

em cảm ơn anh nhiều ạ !

 

[excel_lv1.5]

dạ em chạy thử thì thấy còn lỗi như sau ạ
- ở sheet1 còn lỗi như sau
vd dữ liệu: anhvietvn@gmail.com thì kết quả là anhvietvn
vd dữ liệu: letuan_com@yahoo.com ra kết quả là letuan_com
2 dạng này em ko cần ra kết quả, nhờ anh chỉnh code loại bỏ 2 dạng này với ạ

- ở sheet2 còn lỗi như sau
vd dữ liệu: anh Tuấn <anhtuan@gmail.com> ra kết quả là n , cái này nếu đúng sẽ ko có kết quả
vd dữ liệu: "Phương -www.lephuong.com" <lephuong@gmail.com> ra kết quả là -www.lephuong.com, em cần kết quả đúng là lephuong.com
vd dữ liệu: Phú -phamphu.com <phamphu@gmail.com> ra kết quả là -phamphu.com , em cần kết quả đúng là phamphu.com

em cảm ơn anh nhiều ạ !

Tôi chỉnh cho bạn thêm lần này nữa thôi nhe, bạn sửa code lại như vầy:

Function tach(str As String, Optional n As Long = 1) As String
Dim result()
result = Array(".com.vn", ".org.vn", ".net.vn", ".com", ".net", ".org", ".info", ".biz", ".vn")
With CreateObject("vbscript.regexp")
    .Global = True
    If n = 3 Then
        .Pattern = "(.*www\.)?\-?([a-zA-Z0-9.-]+(" + Replace(Join(result, "|"), ".", "\.") + ")).*<"
    Else
        .Pattern = "([a-zA-Z0-9]+(" + Replace(Join(result, "|"), ".", "\.") + ")).*(@.+)"
    End If
    If .test(str) Then
        Select Case n
            Case 1
                tach = .Execute(str)(0).submatches(0)
            Case 2
                tach = .Execute(str)(0).submatches(2)
            Case 3
                tach = .Execute(str)(0).submatches(1)
        End Select
    End If
End With
End Function

 

[lala_qn]

Tôi chỉnh cho bạn thêm lần này nữa thôi nhe, bạn sửa code lại như vầy:

Function tach(str As String, Optional n As Long = 1) As String
Dim result()
result = Array(".com.vn", ".org.vn", ".net.vn", ".com", ".net", ".org", ".info", ".biz", ".vn")
With CreateObject("vbscript.regexp")
    .Global = True
    If n = 3 Then
        .Pattern = "(.*www\.)?\-?([a-zA-Z0-9.-]+(" + Replace(Join(result, "|"), ".", "\.") + ")).*<"
    Else
        .Pattern = "([a-zA-Z0-9]+(" + Replace(Join(result, "|"), ".", "\.") + ")).*(@.+)"
    End If
    If .test(str) Then
        Select Case n
            Case 1
                tach = .Execute(str)(0).submatches(0)
            Case 2
                tach = .Execute(str)(0).submatches(2)
            Case 3
                tach = .Execute(str)(0).submatches(1)
        End Select
    End If
End With
End Function

dạ ok hết rùi, em cảm ơn anh nhiều ạ !

 

[PHUCANNAIL]

Em có file này nhờ anh/ chị giúp em công thức lọc ra tỉnh, quận huyện và phường/ thị xã với~
Em cám ơn!

 

[snow25]

Em có file này nhờ anh/ chị giúp em công thức lọc ra tỉnh, quận huyện và phường/ thị xã với~
Em cám ơn!

Bạn xem nhé.

Sub locten()
     Dim arr, arr1, lr As Long, i As Long, a As Long, T, j As Integer, b As Integer, k As Byte
     lr = Range("B" & Rows.Count).End(xlUp).Row
     arr = Range("B2:B" & lr).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To 4)
     For i = 1 To UBound(arr, 1)
         T = Split("," & arr(i, 1), ",")
         b = UBound(T)
         a = a + 1
         k = 0
         For j = b To 1 Step -1
             k = k + 1
             If k > 4 Then arr1(a, 4) = arr1(a, 4) & "," & T(j)
             arr1(a, k) = T(j)
         Next j
    Next i
    Range("C2:F" & lr).ClearContents
    Range("C2:F" & lr).Value = arr1
End Sub

 

[CHAOQUAY]

Em có file này nhờ anh/ chị giúp em công thức lọc ra tỉnh, quận huyện và phường/ thị xã với~
Em cám ơn!

Dùng thử hàm tự tạo

Function Tach(Nguon, STT)
Dim Mang
Mang = Split(StrReverse(Nguon), ",")
If STT <= UBound(Mang) + 1 Then
    Tach = StrReverse(Mang(STT - 1))
End If
End Function

 

[snow25]

Dùng thử hàm tự tạo

Function Tach(Nguon, STT)
Dim Mang
Mang = Split(StrReverse(Nguon), ",")
If STT <= UBound(Mang) + 1 Then
    Tach = StrReverse(Mang(STT - 1))
End If
End Function

Dùng 2 cái này
StrReverse
sao không dùng.Ubound(mang)-stt

 

[CHAOQUAY]

Dùng 2 cái này
StrReverse
sao không dùng.Ubound(mang)-stt

Quen tay ý mà