giúp: lọc dữ liệu trùng nhau (3 người xem)

[duongdaicb]

em tìm mãi mà không lọc được,
như file em gửi kèm.
cột a là dữ liệu của bạn em,
Cột b là các dữ liệu của khách hàng của em
nhưng khổ là không thể tìm được khách nào của mình trùng với của nó, kia là ví dụ thôi, thật ra có hơn 2 chục nghìn khách cơ

cám ơn mọi người

 

[khuongvietphong]

em tìm mãi mà không lọc được,
như file em gửi kèm.
cột a là dữ liệu của bạn em,
Cột b là các dữ liệu của khách hàng của em
nhưng khổ là không thể tìm được khách nào của mình trùng với của nó, kia là ví dụ thôi, thật ra có hơn 2 chục nghìn khách cơ

cám ơn mọi người

Bạn có thể dùng CT này tại ô C1: =IF(COUNTIF($A$1:$A$14,B1)>0,"trùng","không trùng")

 

[tờ rung]

em tìm mãi mà không lọc được,
như file em gửi kèm.
cột a là dữ liệu của bạn em,
Cột b là các dữ liệu của khách hàng của em
nhưng khổ là không thể tìm được khách nào của mình trùng với của nó, kia là ví dụ thôi, thật ra có hơn 2 chục nghìn khách cơ

cám ơn mọi người

Tốt nhất là đưa file gốc của bạn lên đây, đưa dữ liệu giả định vào tôi đảm bảo có rất nhiều cách giải quyết cho bạn!

 

[phulien1902]

em tìm mãi mà không lọc được,
như file em gửi kèm.
cột a là dữ liệu của bạn em,
Cột b là các dữ liệu của khách hàng của em
nhưng khổ là không thể tìm được khách nào của mình trùng với của nó, kia là ví dụ thôi, thật ra có hơn 2 chục nghìn khách cơ

cám ơn mọi người

Bạn dùng Code sau:

Sub LocTrung()
    Dim i As Range, j As Range, Rng1 As Range, Rng2 As Range, k As Range
    Set i = Range("A1:A15")
    Set j = Range("B1:B10")
    Application.ScreenUpdating = False
    For Each Rng1 In i
        Cll = [Rng1]
        For Each Rng2 In j
            If Cll = [Rng2] Then
                If k Is Nothing Then
                    Set k = Rng1
                Else
                    Set k = Application.Union(k, Rng1)
                End If
            End If
        Next
    Next
    k.Copy [e1]
    Application.ScreenUpdating = True
End Sub

Để phù hợp với dữ liệu của bạn, bạn thay đổi chữ màu đỏ

 

[doveandrose]

Với dữ liệu lớn bạn dùng Code sau:

Sub LocTrung()
    Dim i As Range, j As Range, Rng1 As Range, Rng2 As Range, k As Range
    Set i = Range("A1:A15")
    Set j = Range("B1:B10")
    Application.ScreenUpdating = False
    For Each Rng1 In i
        Cll = [Rng1]
        For Each Rng2 In j
            If Cll = [Rng2] Then
                If k Is Nothing Then
                    Set k = Rng1
                Else
                    Set k = Application.Union(k, Rng1)
                End If
            End If
        Next
    Next
    k.Copy [e1]
    Application.ScreenUpdating = True
End Sub

Để phù hợp với dữ liệu của bạn, bạn thay đổi chữ màu đỏ

với dữ liệu lớn thì cần phải dùng vòng lặp trên Range hả bạn ? hi hi hi
mình hỏi câu này nếu bạn không ngại thì trả lời , nếu ngại thì thôi
Bạn đã từng làm việc với dữ liệu trên 20 000 dòng trở lên bao giờ chưa bạn ?

 

[phulien1902]

với dữ liệu lớn thì cần phải dùng vòng lặp trên Range hả bạn ?

Cảm ơn doveandrose đã góp ý!Với dữ liệu lớn phải dùng mảng rồi.Quả thực dữ liệu của mình mới có vài ngàn dòng.

 

[duongdaicb]

với dữ liệu lớn thì cần phải dùng vòng lặp trên Range hả bạn ? hi hi hi
mình hỏi câu này nếu bạn không ngại thì trả lời , nếu ngại thì thôi
Bạn đã từng làm việc với dữ liệu trên 20 000 dòng trở lên bao giờ chưa bạn ?

Cám ơn bạn. thưa với bạn là 20 000 dòng thì mới phải hỏi chứ
File kèm theo nhé

 

[doveandrose]

Cám ơn bạn. thưa với bạn là 20 000 dòng thì mới phải hỏi chứ
File kèm theo nhé

ủa bạn kêu tui làm chi . Tui giải quyết được gì ?

 

[befaint]

ủa bạn kêu tui làm chi . Tui giải quyết được gì ?

Nhìn chữ ký là biết "giải quyết" được gì rồi.

@Chủ topic: Bạn cứ bám riết "chú chim hồng" là êm rồi. keke

 

[hcl_pt]

Bạn dùng Code sau:

Sub LocTrung()
    Dim i As Range, j As Range, Rng1 As Range, Rng2 As Range, k As Range
    Set i = Range("A1:A15")
    Set j = Range("B1:B10")
    Application.ScreenUpdating = False
    For Each Rng1 In i
        Cll = [Rng1]
        For Each Rng2 In j
            If Cll = [Rng2] Then
                If k Is Nothing Then
                    Set k = Rng1
                Else
                    Set k = Application.Union(k, Rng1)
                End If
            End If
        Next
    Next
    k.Copy [e1]
    Application.ScreenUpdating = True
End Sub

Để phù hợp với dữ liệu của bạn, bạn thay đổi chữ màu đỏ

Bạn ơi, với dữ liệu là "Set i = Range("A1:A500000")
Set j = Range("B1:B500000")"
mình chạy mất một ngày chưa xong ạ, bạn và GPE có thể xem giúp được không ạ?

 

[comet_1701]

Bạn ơi, với dữ liệu là "Set i = Range("A1:A500000")
Set j = Range("B1:B500000")"
mình chạy mất một ngày chưa xong ạ, bạn và GPE có thể xem giúp được không ạ?

Sub So_Sanh()
  Dim Dic1, Dic2, Sarr, Darr(1 To 65000, 1 To 1)
  Dim i As Long, k As Long
Sarr = Range("A1:B65000").Value
  Set Dic1 = CreateObject("Scripting.Dictionary")
  Set Dic2 = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(Sarr)
    If Not Dic1.Exists(Sarr(i, 1)) And Sarr(i, 1) <> "" Then
      Dic1.Add Sarr(i, 1), ""
    End If
  Next i
  For i = 1 To UBound(Sarr)
    If Not Dic2.Exists(Sarr(i, 2)) And Sarr(i, 2) <> "" Then
      Dic2.Add Sarr(i, 2), ""
      If Dic1.Exists(Sarr(i, 2)) Then
        k = k + 1
        Darr(k, 1) = Sarr(i, 2)
      End If
    End If
  Next i
  [D1:D65000].ClearContents
  [D1].Resize(UBound(Sarr)).Value = Darr
  Set Dic1 = Nothing
  Set Dic2 = Nothing
  End Sub

Bạn thử đoạn này xem có chạy ổn hơn ko?