Nhờ xóa dữ liệu (đơn) trùng ở nhiều cột hoặc sheet (6 người xem)

anhcom1984 · 24/10/14

Em chào anh chị,

Em có file danh sách email khách hàng ở những khu vực khác nhau. (cột A, cột B hoặc sheet A, Sheet B). Mỗi email em để 1 ô thôi ạ.

Vấn đề là khi thu thập email này thì có thể có đối tượng trùng ở cột A và cột B (hoặc sheet A, Sheet B). Em đã lọc được đối tượng trùng ở mỗi cột A hoặc B. Tuy nhiên em không lọc được đối tượng trùng ở 2 cột này cùng lúc. Em muốn xóa luôn những đối tượng trùng, không cần nhặt tách ra làm gì ạ.

Anh chị nào biết chỉ giúp em với ạ.

Em xin cảm ơn nhiều!

File ví dụ đây ạ

nghiaphuc · 24/10/14

anhcom1984 đã viết:
Em chào anh chị,

Em có file danh sách email khách hàng ở những khu vực khác nhau. (cột A, cột B hoặc sheet A, Sheet B). Mỗi email em để 1 ô thôi ạ.

Vấn đề là khi thu thập email này thì có thể có đối tượng trùng ở cột A và cột B (hoặc sheet A, Sheet B). Em đã lọc được đối tượng trùng ở mỗi cột A hoặc B. Tuy nhiên em không lọc được đối tượng trùng ở 2 cột này cùng lúc. Em muốn xóa luôn những đối tượng trùng, không cần nhặt tách ra làm gì ạ.

Anh chị nào biết chỉ giúp em với ạ.

Em xin cảm ơn nhiều!

Cái vụ tìm và xóa này thì có lẽ phải dùng đến VBA rồi. Bạn đưa file Excel lên đây xem sao nhé.

anhcom1984 · 24/10/14

nghiaphuc đã viết:
Cái vụ tìm và xóa này thì có lẽ phải dùng đến VBA rồi. Bạn đưa file Excel lên đây xem sao nhé.

Anh làm ơn hướng dẫn em cách làm được không. Vì dữ liệu em cập nhật cũng thường xuyên. Em ko biết cách làm thì ..... +-+-+-+

anhcom1984 · 27/10/14

ai giúp em vớiiiii....................................................

Quang_Hải · 27/10/14

anhcom1984 đã viết:
ai giúp em vớiiiii....................................................

Có tui đang giúp nèèèèèèèèèèèèèèèèèè
Nhưng hỏng biết thiết kế cái file thế nào nên chưa giúp đượccccccccccccccccccccccccc

Mod có đi ngang thì tiễn bài này lên đường giúp nhé

anhcom1984 · 28/10/14

Em post lên rồi đây ạ, các cao nhân giúp em với ạ

Em xin cảm ơn nhiều ạ

Quang_Hải · 28/10/14

anhcom1984 đã viết:
Em post lên rồi đây ạ, các cao nhân giúp em với ạ

Em xin cảm ơn nhiều ạ

1. Tạo thêm 1 sheet mới và đặt tên sheet là Loc
2. Bấm Alt + F11
3. Insert 1 module mới và copy code vào
4. Bấm F5
5. Gào lên 1 tiếng á................

PHP:

Sub LocEmail()
Dim sh As Worksheet, Temp(), item
With CreateObject("scripting.dictionary")
   For Each sh In Worksheets
      If sh.Name <> "Loc" Then
         Temp = sh.UsedRange.Value
         For Each item In Temp
            If InStr(1, item, "@") > 0 Then
               .item(item) = ""
            End If
         Next
      End If
   Next
   Sheets("Loc").[A1].Resize(.Count) = Application.Transpose(.keys)
End With
End Sub

anhcom1984 · 28/10/14

quanghai1969 đã viết:
1. Tạo thêm 1 sheet mới và đặt tên sheet là Loc
2. Bấm Alt + F11
3. Insert 1 module mới và copy code vào
4. Bấm F5
5. Gào lên 1 tiếng á................

PHP:

Sub LocEmail() Dim sh As Worksheet, Temp(), item With CreateObject("scripting.dictionary") For Each sh In Worksheets If sh.Name <> "Loc" Then Temp = sh.UsedRange.Value For Each item In Temp If InStr(1, item, "@") > 0 Then .item(item) = "" End If Next End If Next Sheets("Loc").[A1].Resize(.Count) = Application.Transpose(.keys) End With End Sub

hi hi chết cười với bác. Em bấm F5 rồi. Á rồi ạ, nhưng mà là lỗi ^^ Lỗi đầu sai chính tả em sửa dc rùi ^^ Em cảm ơn bác đã nhiệt tình giúp đỡ

Cơ mà em muốn xóa đi phần tử bị trùng ở các cột email hoặc ở mỗi sheet ấy bác ạ, nhưng ko bị xáo trộn (như bác làm là nhập hết vào với nhau) nội dung email ở các cột hoặc sheet, mail nào ở cột/sheet nào thì vẫn ở đó ạ (vì em có phân nhóm email). Chỉ xóa email trùng đi thôi ạ, xóa ở cột nào hoặc sheet nào cũng dc. Bác giúp em nhé, Em cảm ơn bác nhiều nhiều

Quang_Hải · 28/10/14

anhcom1984 đã viết:
@quanghai1969
hi hi chết cười với bác. Em bấm F5 rồi. Á rồi ạ, nhưng mà là lỗi ^^ Lỗi đầu sai chính tả em sửa dc rùi ^^ Em cảm ơn bác đã nhiệt tình giúp đỡ

Cơ mà em muốn xóa đi phần tử bị trùng ở các cột email hoặc ở mỗi sheet ấy bác ạ, nhưng ko bị xáo trộn (như bác làm là nhập hết vào với nhau) nội dung email ở các cột hoặc sheet, mail nào ở cột/sheet nào thì vẫn ở đó ạ (vì em có phân nhóm email). Chỉ xóa email trùng đi thôi ạ, xóa ở cột nào hoặc sheet nào cũng dc. Bác giúp em nhé, Em cảm ơn bác nhiều nhiều

Vậy thử lại coi có á nữa không nhá

PHP:

Sub LocEmail()
Dim sh As Worksheet, Temp(), item
With CreateObject("scripting.dictionary")
   For Each sh In Worksheets
      If sh.Name <> "Loc" Then
         If sh.UsedRange.Count > 1 Then
            Temp = sh.UsedRange.Value
            For Each item In Temp
               If InStr(1, item, "@") > 0 Then
                  If Not .Exists(item) Then .Add item,""
               End If
            Next
         End If
      End If
   Next
   Sheets("Loc").[A1].Resize(.Count) = Application.Transpose(.keys)
End With
End Sub

Code này lọc từng sheet đây

PHP:

Sub Loc_Email()
Dim Sh As Worksheet, temp(), item
With CreateObject("scripting.dictionary")
   If ActiveSheet.UsedRange.Count > 1 Then
      temp = ActiveSheet.UsedRange.Value
      For Each item In temp
         If InStr(1, item, "@") > 0 Then
            If Not .exists(item) Then .Add item, ""
         End If
      Next
   End If
   ActiveSheet.[A1].Resize(.Count) = Application.Transpose(.keys)
End With
End Sub

anhcom1984 · 31/10/14

Ui xin lỗi bác vì mấy hôm em bận quá, hôm nay mới sờ lại món này. Em rất cảm ơn bác đã nhiệt tình giúp đỡ ạ. Em sẽ thử ngay đây --=0

quanghai1969 đã viết:

Vậy thử lại coi có á nữa không nhá

PHP:

Sub LocEmail()
Dim sh As Worksheet, Temp(), item
With CreateObject("scripting.dictionary")
   For Each sh In Worksheets
      If sh.Name <> "Loc" Then
         If sh.UsedRange.Count > 1 Then
            Temp = sh.UsedRange.Value
            For Each item In Temp
               If InStr(1, item, "@") > 0 Then
                  If Not .Exists(item) Then .Add item,""
               End If
            Next
         End If
      End If
   Next
   Sheets("Loc").[A1].Resize(.Count) = Application.Transpose(.keys)
End With
End Sub

Code này lọc từng sheet đây

PHP:

Sub Loc_Email()
Dim Sh As Worksheet, temp(), item
With CreateObject("scripting.dictionary")
   If ActiveSheet.UsedRange.Count > 1 Then
      temp = ActiveSheet.UsedRange.Value
      For Each item In temp
         If InStr(1, item, "@") > 0 Then
            If Not .exists(item) Then .Add item, ""
         End If
      Next
   End If
   ActiveSheet.[A1].Resize(.Count) = Application.Transpose(.keys)
End With
End Sub

anhcom1984 · 31/10/14

@quanghai1969 Bác ơi em thử rồi. Cơ mà đấy là bác gộp các sheet của em làm một.

Em muốn nó tự xóa những email trùng ở các sheet với nhau. Nhưng email của sheet nào vẫn còn ở sheet đó bác ạ.

Quang_Hải · 31/10/14

anhcom1984 đã viết:
@quanghai1969 Bác ơi em thử rồi. Cơ mà đấy là bác gộp các sheet của em làm một.

Em muốn nó tự xóa những email trùng ở các sheet với nhau. Nhưng email của sheet nào vẫn còn ở sheet đó bác ạ.

Chưa trúng thì thử tiếp

PHP:

Sub LocEmail()
Dim sh As Worksheet, Temp(), i&, j&, k&
With CreateObject("scripting.dictionary")
   For Each sh In Worksheets
      If sh.Name <> "Loc" Then
         If sh.UsedRange.Count > 1 Then
            Temp = sh.UsedRange.Value
            For i = 1 To UBound(Temp)
               For j = 1 To UBound(Temp, 2)
                  If InStr(1, Temp(i, j), "@") > 0 Then
                     If Not .Exists(Temp(i, j)) Then
                        .Add Temp(i, j), ""
                        k = k + 1
                        Temp(k, j) = Temp(i, j)
                     End If
                  End If
               Next
            Next
         End If
      End If
      With sh.UsedRange
         .ClearContents
         .Cells(1, 1).Resize(k, j - 1) = Temp
      End With
      k = 0
   Next
End With
End Sub

anhcom1984 · 9/11/14

Bị lỗi bác ạ

em ko biết sửa

quanghai1969 đã viết:

Chưa trúng thì thử tiếp

PHP:

Sub LocEmail()
Dim sh As Worksheet, Temp(), i&, j&, k&
With CreateObject("scripting.dictionary")
   For Each sh In Worksheets
      If sh.Name <> "Loc" Then
         If sh.UsedRange.Count > 1 Then
            Temp = sh.UsedRange.Value
            For i = 1 To UBound(Temp)
               For j = 1 To UBound(Temp, 2)
                  If InStr(1, Temp(i, j), "@") > 0 Then
                     If Not .Exists(Temp(i, j)) Then
                        .Add Temp(i, j), ""
                        k = k + 1
                        Temp(k, j) = Temp(i, j)
                     End If
                  End If
               Next
            Next
         End If
      End If
      With sh.UsedRange
         .ClearContents
         .Cells(1, 1).Resize(k, j - 1) = Temp
      End With
      k = 0
   Next
End With
End Sub

TrungChinhs · 9/11/14

Bạn cho thử ví dụ trường hợp nào được coi là trùng. Sao Tôi kiểm tra không thấy cái mail nào trùng nhỉ ?

Nhờ xóa dữ liệu (đơn) trùng ở nhiều cột hoặc sheet (6 người xem)

Người dùng đang xem chủ đề này

anhcom1984

Thành viên mới

File đính kèm

nghiaphuc

Thành viên gạo cội

anhcom1984

Thành viên mới

anhcom1984

Thành viên mới

Quang_Hải

Thành viên gạo cội

anhcom1984

Thành viên mới

File đính kèm

Quang_Hải

Thành viên gạo cội

anhcom1984

Thành viên mới

Quang_Hải

Thành viên gạo cội

anhcom1984

Thành viên mới

anhcom1984

Thành viên mới

Quang_Hải

Thành viên gạo cội

anhcom1984

Thành viên mới

TrungChinhs

Thành viên tích cực

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian