Tìm câu trùng lặp

[thlpro]

Chào ACE!
Mình có file câu hỏi. Yêu cầu của mình như sau:
- Tìm câu trùng lặp cho toàn bộ cả sheet sau khi mình bấm vào Nút TÌM CÂU TRÙNG LẶP, Nếu câu nào trùng thì hiện lên màu đỏ và chữ đậm, Ví dụ trong file của mình có câu 2 có câu "The person who controls the way in which business is done in an organization which makes laws, such as a parliament" trùng lặp.

Lưu ý: Chỉ trùng lặp cho từng câu thôi. Trong ví dụ mình có tổng cộng 31 câu, mỗi câu có 4 câu trả lời. Chỉ tìm câu trùng lặp ở những câu trả lời thôi.

Cảm ơn ACE giúp đỡ!

 

[ndu96081631]

Chào ACE!
Mình có file câu hỏi. Yêu cầu của mình như sau:
- Tìm câu trùng lặp cho toàn bộ cả sheet sau khi mình bấm vào Nút TÌM CÂU TRÙNG LẶP, Nếu câu nào trùng thì hiện lên màu đỏ và chữ đậm, Ví dụ trong file của mình có câu 2 có câu "The person who controls the way in which business is done in an organization which makes laws, such as a parliament" trùng lặp.

Lưu ý: Chỉ trùng lặp cho từng câu thôi. Trong ví dụ mình có tổng cộng 31 câu, mỗi câu có 4 câu trả lời. Chỉ tìm câu trùng lặp ở những câu trả lời thôi.

Cảm ơn ACE giúp đỡ!

Làm bằng công thức được không?
- Gõ công thức này vào C2:

=IF(D2="","",COUNTA($A$1:$A2))

Kéo fill xuống
- Quét chọn D2155, bấm Conditional Formating, chọn New Rule, chọn mục "Use a formula to determine... " rồi gõ công thức này vào khung Edit the Rule Description:

=COUNTIF(IF($C2="","",OFFSET($D$2,MATCH($C2,C$2:C$155,0)-1,,COUNTIF(C$2:C$155,$C2),)),$D2)>1

- Bấm nút Format, tô màu tùy ý

 

[thlpro]

Dùng công thức thì hơi bất tiện, vì mình cũng làm được. Mình muốn có đoạn code nào làm việc đó nhanh hơn ko. Vì số lượng câu hỏi mình nhiều, nên công thức rất mất nhiều thời gian. Rất mong sự giúp đỡ của bạn.

 

[ndu96081631]

Dùng công thức thì hơi bất tiện, vì mình cũng làm được. Mình muốn có đoạn code nào làm việc đó nhanh hơn ko. Vì số lượng câu hỏi mình nhiều, nên công thức rất mất nhiều thời gian. Rất mong sự giúp đỡ của bạn.

Muốn code thì code:

Sub DuplicateColor(sRng As Range)
  Dim Area As Range, Clls As Range, i As Long, j As Long
  On Error GoTo ExitSub
  With CreateObject("Scripting.Dictionary")
    For Each Area In sRng.SpecialCells(2).Areas
      .RemoveAll
      i = 0
      For Each Clls In Area
        i = i + 1
        If Not .Exists(Clls.Value) Then
          .Add Clls.Value, i
        Else
          Clls.Font.ColorIndex = 3
          Clls.Font.Bold = True
          Area(.Item(Clls.Value)).Font.ColorIndex = 3
          Area(.Item(Clls.Value)).Font.Bold = True
        End If
      Next Clls
    Next Area
  End With
ExitSub:
End Sub

Sub Main()
  Dim sRng As Range
  Set sRng = Range([D2], [D65536]).End(xlUp)
  sRng.Font.Bold = False
  sRng.Font.ColorIndex = 1
  DuplicateColor sRng
End Sub

Chạy sub Main sẽ thấy kết quả
(Chạy tạm thôi chứ dùng SpecialCells cũng hơi nguy hiểm chút)

 

[thlpro]

(Chạy tạm thôi chứ dùng SpecialCells cũng hơi nguy hiểm chút): Có nghĩa là sao hả bạn. Có thể giải thích cho mình biết được không.

 

[ndu96081631]

(Chạy tạm thôi chứ dùng SpecialCells cũng hơi nguy hiểm chút): Có nghĩa là sao hả bạn. Có thể giải thích cho mình biết được không.

Nói chung, dùng SpecialCells để xác định 1 vùng đặc biệt ---> Như đoạn code trên dùng SpecialCells(2) là để xác định vùng dữ liệu không chứa BlankCells ---> Như vậy, code sẽ bị lỗi nếu như vùng dữ liệu trống rổng chẳng có chữ nào (chính thế mà tôi phải phòng ngừa bằng câu lệnh On Error GoTo ExitSub)

 

[thlpro]

Trên cả tuyệt vời. Cảm ơn bạn nhiều.

 

[concogia]

Nói chung, dùng SpecialCells để xác định 1 vùng đặc biệt ---> Như đoạn code trên dùng SpecialCells(2) là để xác định vùng dữ liệu không chứa BlankCells ---> Như vậy, code sẽ bị lỗi nếu như vùng dữ liệu trống rổng chẳng có chữ nào (chính thế mà tôi phải phòng ngừa bằng câu lệnh On Error GoTo ExitSub)

Biết là nguy hiểm sao....còn nhào "zô" chi, vừa .......vừa run, híc, tránh voi chẳng xấu mặt nào, nếu cấu trúc dữ liệu đúng y chang như thế có thể chạy code này:

Public Sub Trung()
Dim Vung As Range, Cll As Range, i As Long, VungDo As Range
    Application.ScreenUpdating = False
    Set Vung = Range([D2], [d1000].End(xlUp))
        With Vung.Font
            .ColorIndex = xlAutomatic
            .Bold = False
        End With
            For i = 1 To Vung.Rows.Count Step 5
                Set VungDo = Vung(i).Resize(4)
                    For Each Cll In VungDo
                        If Cll <> "" And Application.WorksheetFunction.CountIf(VungDo, Cll) > 1 Then
                            With Cll.Font
                                .ColorIndex = 3
                                .Bold = True
                            End With
                        End If
                    Next Cll
            Next i
    Application.ScreenUpdating = True
End Sub