Tách riêng từng email trong một ô excel (2 người xem)

[tiencruise]

Chào mọi người,

Em đang có một file dữ liệu, trong 1 ô có rất nhiều email cách nhau cách nhau bằng một dấu ";".
Có cách nào để mình tách riêng ra từng cột cho những email này không? Em đang cần dùng mail merge để gừi mail .

Cảm ơn mọi người.

 

[khoavu87]

Chào mọi người,

Em đang có một file dữ liệu, trong 1 ô có rất nhiều email cách nhau cách nhau bằng một dấu ";".
Có cách nào để mình tách riêng ra từng cột cho những email này không? Em đang cần dùng mail merge để gừi mail .

Cảm ơn mọi người.

Thử dùng chức năng này xem sao?
Data -> Text to c0lumns

 

[uronmapu]

Nếu không phải là dấu chấm phẩy mà có lúc có dấu ; có lúc có dấu / hay , hoặc - hoặc xuống dòng thì làm thế nào?

 

[Quang_Hải]

Nếu không phải là dấu chấm phẩy mà có lúc có dấu ; có lúc có dấu / hay , hoặc - hoặc xuống dòng thì làm thế nào?

Cách thì có nhưng không có file để xem dạng dữ liệu thì khó thật đấy, mình nghĩ chắc bạn hỏi cho vui, vì nếu cần bạn đã gởi file lên rồi.

 

[uronmapu]

Bác xem file đính kèm và giúp e nhé

Cảm ơn

 

[Quang_Hải]

Bác xem file đính kèm và giúp e nhé

Cảm ơn

Giả sử cột dữ liệu của bạn như trong file

Chạy code này, sau đó dùng chức năng Text to Columns để xử lý

Sub thay_ky_tu()
  With Range([a2], [a65536].End(3))
    .Replace ChrW(10), ";"
    .Replace "-", ";"
    .Replace "/", ";"
    .Replace ",", ";"
    .Replace ":", ";"
  End With
End Sub

 

[uronmapu]

Chạy code như thế nào ạ bác

 

[nmhung49]

Bác xem file đính kèm và giúp e nhé
Cảm ơn

Với file bạn dùng text to column ở bước cuối cùng bạn check toàn bộ và other thì đánh dấu ; sau đó dùng Ctrl + H thay thế mấy ký tự kia, hoặc dùng code của bạn quanghai

 

[uronmapu]

trong other chỉ nhập được 1 ký tự thội ạ

Xin các bác hướng dẫn cách chạy code như thế nào, e ko hiểu lắm

 

[Quang_Hải]

Với file bạn dùng text to column ở bước cuối cùng bạn check toàn bộ và other thì đánh dấu ; sau đó dùng Ctrl + H thay thế mấy ký tự kia, hoặc dùng code của bạn quanghai

Cái chuỗi chrw(10) có tìm và thay được không? Mình đã cố thử nhưng không thay được cái (Alt + Enter)

 

[nmhung49]

Cái chuỗi chrw(10) có tìm và thay được không? Mình đã cố thử nhưng không thay được cái (Alt + Enter)

Thì quanghai nhấn Alt + 010 bên phím số là được mà Uronmapu làm được chưa vậy nếu không được đưa file chính thức của bạn lên nhen

 

[Quang_Hải]

Chạy code như thế nào ạ bác

Nếu đã xài code thì xài code tất tần tật cho rồi.

Sub tach_email()
Dim dl, tachra, kq()
Dim n As Byte, i As Long, j As Byte
  With Range([a2], [a65536].End(3))
    .Replace ChrW(10), ";"
    .Replace "-", ";":    .Replace "/", ";"
    .Replace ",", ";":    .Replace ":", ";"
  End With
  dl = Range([a2], [a65536].End(3))
  For i = 1 To UBound(dl)
    tachra = Split(dl(i, 1), ";")
    If UBound(tachra) > n Then n = UBound(tachra)
    ReDim Preserve kq(1 To UBound(dl, 1), 1 To n + 1)
    For j = 0 To UBound(tachra)
      kq(i, j + 1) = Trim(tachra(j))
    Next
  Next
  [b2].Resize(i - 1, n + 1) = kq
End Sub

 

[uronmapu]

File mình đã gửi lên rồi mà

Xin bác quanghai hướng dẫn e cách chạy code thế nào ạ

 

[Quang_Hải]

File mình đã gửi lên rồi mà

Xin bác quanghai hướng dẫn e cách chạy code thế nào ạ

Phải biết cách Enable Macros nhé

 

[uronmapu]

Cảm ơn bác quanghai lần nữa, nhưng bác làm là tách ra các cột khác nhau

Em muốn nó tách xuống hàng tiếp theo thì có làm được ko ạ

Nghĩa là 2 email trên 1 dòng nó sẽ tách thành 2 dòng (mỗi email trên 1 dòng) chứ ko phải tách làm 2 cột như trong ví dụ bác làm

Xin bác giúp em

 

[Quang_Hải]

Cảm ơn bác quanghai lần nữa, nhưng bác làm là tách ra các cột khác nhau

Em muốn nó tách xuống hàng tiếp theo thì có làm được ko ạ

Nghĩa là 2 email trên 1 dòng nó sẽ tách thành 2 dòng (mỗi email trên 1 dòng) chứ ko phải tách làm 2 cột như trong ví dụ bác làm

Xin bác giúp em

Bạn thay code này vào sẽ được

Sub tach_email()
Dim dic As Object
Dim dl, tachra
Dim i As Long, j As Byte
Set dic = CreateObject("scripting.dictionary")
  With Range([B2], [B65536].End(3))
    .Replace ChrW(10), ";"
      .Replace "-", ";":    .Replace "/", ";"
        .Replace ",", ";":    .Replace ":", ";"
          End With
dl = Range([B2], [B65536].End(3))
  For i = 1 To UBound(dl)
    tachra = Split(dl(i, 1), ";")
      For j = 0 To UBound(tachra)
        If Not dic.exists(Trim(tachra(j))) Then
          dic.Add Trim(tachra(j)), ""
        End If
      Next
  Next
[c2].Resize(dic.Count) = Application.Transpose(dic.keys)
End Sub

 

[concogia]

Thêm cách không dùng vòng lặp:

Public Sub TachEmail()
    Dim Vung As Range, Tach, Gom As String
    Set Vung = Range([A2], [A10000].End(xlUp))
    Gom = Join(Application.WorksheetFunction.Transpose(Vung), ";")
    Gom = Replace(Gom, " ", ""): Gom = Replace(Gom, ";", " "): Gom = Replace(Gom, ":", " ")
    Gom = Replace(Gom, ",", " "): Gom = Replace(Gom, "-", " "): Gom = Replace(Gom, "/", " "): Gom = Replace(Gom, Chr(10), " ")
        Tach = Split(Gom)
    [B2:B10000].ClearContents
    [B2].Resize(UBound(Tach) + 1) = Application.WorksheetFunction.Transpose(Tach)
End Sub

Hoặc:

Public Sub TachEmail123()
    Dim Vung As Range, Tach, Gom As String, Re
    Set Re = CreateObject("vbscript.regexp")
    Set Vung = Range([A2], [A10000].End(xlUp))
    Gom = Join(Application.WorksheetFunction.Transpose(Vung), ";"): Gom = Replace(Gom, " ", "")
            With Re
                .Global = True
                .IgnoreCase = True
                .Pattern = "\;|\,|\/|\n|\:|\-"
                Gom = .Replace(Gom, " ")
           End With
        Tach = Split(Gom)
    [B2:B10000].ClearContents
    [B2].Resize(UBound(Tach) + 1) = Application.WorksheetFunction.Transpose(Tach)
End Sub

Thân

 

[uronmapu]

Cảm ơn bác quanghai nhiều
Bác đã giúp e khá nhiều câu hỏi ạ

Em cảm ơn bác

 

[uronmapu]

Xin hỏi các bác là thêm trường hợp email có kiểu như bên dưới thì làm sao ạ

uron@yahoo.com matmetide@gmail.com (có dấu cách)

uron@yahoo.com/ matmetide@gmail.com (gạch và dấu cách)

uron@yahoo.com: matmetide@gmail.com (hai chấm và cách)

uron@yahoo.com or matmetide@gmail.com (cách or và cách)

 

[Quang_Hải]

Xin hỏi các bác là thêm trường hợp email có kiểu như bên dưới thì làm sao ạ

uron@yahoo.com matmetide@gmail.com (có dấu cách)

uron@yahoo.com/ matmetide@gmail.com (gạch và dấu cách)

uron@yahoo.com: matmetide@gmail.com (hai chấm và cách)

uron@yahoo.com or matmetide@gmail.com (cách or và cách)

Bạn xem nghiên cứu cái này, có ký tự nào phát sinh thì cứ thêm vào sẽ tách được

Sub Tach_email()
  With [a:a]
    .Replace "/", ";" 'Chuyen dấu / thành dấu ;
    .Replace "or", ";"  'chuyển chữ or  thành dấu ;
    .Replace "  ", ";" 'chuyển 2 dấu cách liên tiếp nếu có thành dấu ;
    .TextToColumns [b1], Semicolon:=True, Comma:=True, _
    Space:=True, OtherChar:=":"
  End With
End Sub