Tìm dữ liệu bị trùng lặp trong Excel

[hoangithp]

Nhờ các bạn giúp mình xây dựng 1 hàm (xla) hoặc một file excel có tính năng tìm các dữ liệu bị trùng nhau và hiển thị các kết quả về dữ liệu trùng nhau.
Như hình mẫu hoặc file này.
Mình cảm ơn.

 

[Hai Lúa Miền Tây]

Nhờ các bạn giúp mình xây dựng 1 hàm (xla) hoặc một file excel có tính năng tìm các dữ liệu bị trùng nhau và hiển thị các kết quả về dữ liệu trùng nhau.
Như hình mẫu hoặc file này.
Mình cảm ơn.

Có rất nhiều cách liệt kê:
Dùng name, PivotTable, Consolidate, sort rồi subtotal...
Ở đây tôi dùng PivotTable, Consolidate
Bạn xem file nhé

 

[hoangithp]

Mình chưa hiểu cách làm nhờ bạn hỗ trợ, mình dùng Office 2007 !
Thanks

 

[ChanhTQ@]

Thêm 1 hướng nữa, mong rằng nó sẽ dễ hiểu với bạn

Option Explicit:        Option Base 1
Sub TimTrung1Cot()
 Dim Rng As Range, sRng As Range, Clls As Range
 Dim MyAdd As String, SLan As Byte

 Set Rng = Range([B3], [B65500].End(xlUp))
 ReDim DaCo(Rng.Count) As Boolean
 For Each Clls In Rng.Offset(1)
   If Not DaCo(Clls.Row - 3) Then
      Set sRng = Rng.Find(Clls.Value, , xlFormulas, xlWhole)
      If Not sRng Is Nothing Then
         MyAdd = sRng.Address
         Do
            SLan = SLan + 1:         DaCo(sRng.Row - 3) = True
            Set sRng = Rng.FindNext(sRng)
         Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
         With [e65500].End(xlUp).Offset(1)
            If SLan > 1 Then
               .Value = sRng.Value
               .Offset(, 1).Value = SLan
            End If
            SLan = 0
         End With
      End If
   End If
 Next Clls
End Sub

 

[nguyendangkhoi]

Option Explicit:        Option Base 1
Sub TimTrung1Cot()
 Dim Rng As Range, sRng As Range, Clls As Range
 Dim MyAdd As String, SLan As Byte
 
 Set Rng = Range([B3], [B65500].End(xlUp))
 ReDim DaCo(Rng.Count) As Boolean
 For Each Clls In Rng.Offset(1)
   If Not DaCo(Clls.Row - 3) Then
      Set sRng = Rng.Find(Clls.Value, , xlFormulas, xlWhole)
      If Not sRng Is Nothing Then
         MyAdd = sRng.Address
         Do
            SLan = SLan + 1:         DaCo(sRng.Row - 3) = True
            Set sRng = Rng.FindNext(sRng)
         Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
         With [e65500].End(xlUp).Offset(1)
            If SLan > 1 Then
               .Value = sRng.Value
               .Offset(, 1).Value = SLan
            End If
            SLan = 0
         End With
      End If
   End If
 Next Clls
End Sub

Cái này mình muốn thêm cột địa chỉ trùng nữa được không Anh ChanhTQ@

 

[ChanhTQ@]

Bạn hãy đưa dữ liệu giả lập lên đi, nào!

cái này mình muốn thêm cột địa chỉ trùng nữa được không anh chanhtq@

 

[nguyendangkhoi]

Vẫn dữ liệu như ở trên thoi anh ạh

 

[thuyyeu99]

Vẫn dữ liệu như ở trên thoi anh ạh

Nó có sãn trong Code của anh ChanhTQ@ rồi đó bạn.

thêm cái này vào thử xem đúng ý chưa

With [e65500].End(xlUp).Offset(1)
            If SLan > 1 Then
               .Value = sRng.Value
               .Offset(, 1).Value = SLan
               ''''''''''''''''''''''''''''''''''''''''
               Do
               .Offset(, 2).Value = .Offset(, 2).Value & " / " & sRng.Address
               Set sRng = Rng.FindNext(sRng)
               Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
''''''''''''''''''''''''''''''''''''''''''''''''''
            End If
            SLan = 0
         End With

 

[hoangithp]

Cảm ơn các bạn, nhưng mục dữ liệu mỗi lần mình phải điều chỉnh thủ công trong Macro à !
Em thấy các vị trí rồi.
Cảm ơn các anh đã hỗ trợ, đoạn code của em nó Open Box nên không hay lắm.

Sub KiemtraDulieutrung()
Dim cell As Range
For Each cell In Selection
If WorksheetFunction.CountIf(Selection, cell) > 1 Then cell.Interior.ColorIndex = 3
Next
End Sub