Giúp tách chỗi Email, Điện thoại trong chuỗi văn bản (1 người xem)

[doanhoanghai]

Hiện tại mình đang có cơ sở dữ liệu khách hàng như file đính kèm mà không biết phải làm sao tách được số điện thoại, tên khách hàng và địa chỉ email, mong mọi người giúp mình với . trân thành cảm ơn

 

[doanhoanghai]

Các bác giúp em với ! Em mới làm được tách các số điện thoại ra nhưng do DL lung tung quá chưa biết phải làm sao nữa cả

 

[patygate591]

Cái này file gốc là file gì vậy bạn... Mình không nghĩ người ta ngồi gõ tay ra cái đống này đâu @@
Bạn có thể đưa file gốc lên được không...

 

[killitmore]

Em nghĩ nếu chỉnh lại dữ lieu 1 chút thì có thể tách cả tên, sdt và email thế này ạ
http://www.mediafire.com/view/t4zic4qo27gc6lc/tach_ten_email_sdt.xlsm
Bác thông cảm em hết dung lượng nên không up trực tiếp lên được

 

[bebo021999]

Phức tạp nhất với những ô có nhiều tên và nhiều địa chỉ, nhiều SĐT.

 

[doatmenhhon]

Chả cần sửa gì sất đến chiều rảnh tôi rút nốt tên cho. Giờ mới rút số điện thoại với mail. See u again

 

[Ba Tê]

Các bác giúp em với ! Em mới làm được tách các số điện thoại ra nhưng do DL lung tung quá chưa biết phải làm sao nữa cả

Lung tung thì làm theo kiểu lung tung.
Chuỗi nào có "@" thì dồn vào 1 cột, chuỗi nào có "số" thì dồn vào 1 cột, còn lại dồn vào 1 cột.
Trong cái đống "xà bần" đó không biết số nào là số ĐT.

Public Sub tachtach()
Dim sArr(), dArr(), I As Long, J As Long, Tem, Str As String
sArr = Range("A2", Range("A2").End(xlDown)).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 3)
For I = 1 To UBound(sArr, 1)
    Str = Replace(sArr(I, 1), ChrW(10), ChrW(32))
    Str = Replace(Str, "( ", "(")
    Str = Replace(Str, ":", ChrW(32))
    Tem = Split(Trim(Str), ChrW(32))
    For J = 0 To UBound(Tem)
        If InStr(Tem(J), "@") Then
            dArr(I, 3) = dArr(I, 3) & ChrW(32) & Tem(J)
        ElseIf IsNumeric(Mid(Tem(J), 2, 1)) Or IsNumeric(Mid(Tem(J), 3, 1)) Then
            dArr(I, 2) = dArr(I, 2) & ChrW(32) & Tem(J)
        Else
            dArr(I, 1) = dArr(I, 1) & ChrW(32) & Tem(J)
        End If
    Next J
Next I
Range("B2").Resize(I - 1, 3) = dArr
End Sub

 

[doanhoanghai]

Thank các thánh nhé. Tuy nhiên đối với một số ô A9 với DL [TABLE="width: 251"]
[TR]
[TD="class: xl63, width: 251"]
Nguyễn Thị Phương
linhpt@fujiseiko.com.vn
01656084075
Ms. Huyền
huyenlt@fujiseiko.com.vn
0973625669

Có cách nào tách được ra

B9 : Nguyễn Thị Phương
C9 : linhpt@fujiseiko.com.vn
D9 : 01656084075
E9 : Ms. Huyền
F9 : huyenlt@fujiseiko.com.vn
G9 : 0973625669

Chứ gộp chung vào một ô cũng chưa thực sự chiệt để lắm. [/TD]
[/TR]
[/TABLE]

 

[doanhoanghai]

Cái này file gốc là file gì vậy bạn... Mình không nghĩ người ta ngồi gõ tay ra cái đống này đâu @@
Bạn có thể đưa file gốc lên được không...

Không phải là do bộ phần quản lý khách hàng lúc chăm sóc tiện viết luôn vào 1 ô bàn à.

 

[doatmenhhon]

Tạm thế này đã đến mai sẽ có cách hoàn hảo

 

[doanhoanghai]

Tạm thế này đã đến mai sẽ có cách hoàn hảo

Sớm giúp mình nha. Mình đang phải làm thủ công để tách ra này khổ quá.

 

[doatmenhhon]

Có lẽ mình chỉ làm đến thế này thôi vì thực dữ liệu không đẹp để làm một nèo. Mong sự giúp đỡ của các thành viên khác

 

[Let'GâuGâu]

Sớm giúp mình nha. Mình đang phải làm thủ công để tách ra này khổ quá.

tách cái nào có mấy cái enter xuống dòng
cũng được khoảng 70-80%

Option Explicit
Sub tt()
Dim tach(1 To 60000, 1 To 3), arr, v, tam As Variant, i As Long, mys As String
arr = [a2:a60000]

For i = 1 To UBound(arr)
    If arr(i, 1) = "" Then Exit For
    tam = Split(arr(i, 1), Chr(10))
    For Each v In tam
        mys = Trim(v)
            If mys <> "" Then
                If InStr(1, mys, "@") Then
                    If tach(i, 3) = "" Then tach(i, 3) = mys Else tach(i, 3) = tach(i, 3) & Chr(10) & mys
                Else
                    If InStr(1, mys, 0) Then
                        If tach(i, 2) = "" Then tach(i, 2) = Replace(mys, "/", Chr(10)) Else tach(i, 2) = tach(i, 2) & Chr(10) & Replace(mys, "/", Chr(10))
                    Else
                        If tach(i, 1) = "" Then tach(i, 1) = Split(mys, "|")(0) Else tach(i, 1) = tach(i, 1) & Chr(10) & Split(mys, "|")(0)
                    End If
                End If
            End If
    Next
Next i
[b2].Resize(i, 3) = tach
End Sub