Nhờ thêm đoạn Code đếm có bao nhiêu dữ liệu cùng loại trùng nhau (1 người xem)

[frantliem]

Em đã có đoạn Code đếm các dữ liệu trùng nhau. Nhưng muốn đếm các dữ liệu cùng loại trùng nhau. Học lõm bí nhờ các sư huynh.
Như 233 trùng nhau là 1 dữ liệu trùng,
Như 234 trùng nhau là 1 dữ liệu trùng.......
Em muốn đếm có bao nhiêu dữ liệu như vậy.
Cám ơn nhiều

 

[giaiphap]

Bạn sửa code lại thế này xem sao.

Sub Button1_Click()
Dim count As Long
Dim dupCount As Long
Dim count1 As Long, dem As Long
count = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row


count1 = 1
While count1 <= count


If (WorksheetFunction.CountIf(Range("B1:" & "B" & count), Cells(count1, 2)) > 1) And _
(WorksheetFunction.CountIf(Range("B1:" & "B" & count1), Cells(count1, 2)) = 1) Then dem = dem + 1
      
count1 = count1 + 1


Wend
MsgBox "Co " & dem & " du lieu trung nhau"
End Sub

 

[VetMini]

Bạn sửa code lại thế này xem sao.

Sub Button1_Click()
Dim count As Long
Dim dupCount As Long
Dim count1 As Long, dem As Long
count = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row


count1 = 1
While count1 <= count


If (WorksheetFunction.CountIf(Range("B1:" & "B" & count), Cells(count1, 2)) > 1) And _
(WorksheetFunction.CountIf(Range("B1:" & "B" & count1), Cells(count1, 2)) = 1) Then dem = dem + 1
      
count1 = count1 + 1


Wend
MsgBox "Co " & dem & " du lieu trung nhau"
End Sub

Nếu bạn tính theo kiểu nới range từng dòng một thì chỉ cần xét CountIf = 2 là được rồi

 

[VetMini]

Bài này thực ra còn 2 cách làm nữa cũng tương đối hữu hiệu.

1. Dùng ADO để đọc và lọc những dòng có count > 1

2. Dùng 2 dictionaries. Dic đầu dùng để chứa mã. Dic sau dùng để chứa các mã có trùng. Tức là đọc range và ghi mã vào Dic1; nếu mã đã có trong Dic1 thì ghi sang Dic2. Đọc xong chỉ việc lôi count của Dic2 là ra.

 

[frantliem]

Nếu bạn tính theo kiểu nới range từng dòng một thì chỉ cần xét CountIf = 2 là được rồi

Không chạy bạn ơi. Lỗi code

 

[frantliem]

Thấy rồi bạn, thiếu end if

 

[frantliem]

Bạn sửa code lại thế này xem sao.

Sub Button1_Click()
Dim count As Long
Dim dupCount As Long
Dim count1 As Long, dem As Long
count = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row


count1 = 1
While count1 <= count


If (WorksheetFunction.CountIf(Range("B1:" & "B" & count), Cells(count1, 2)) > 1) And _
(WorksheetFunction.CountIf(Range("B1:" & "B" & count1), Cells(count1, 2)) = 1) Then dem = dem + 1
      
count1 = count1 + 1


Wend
MsgBox "Co " & dem & " du lieu trung nhau"
End Sub

Nếu em muốn đếm như trên với điều kiện là cột C có giá trị rỗng được không các anh chị. Nghĩa là lọc giá trị rỗng rồi mới đếm các dữ liệu cùng loại trùng nhau.
Cám ơn bạn. Đoạn mã trên làm mình học hỏi rất nhiều

 

[giaiphap]

Nếu em muốn đếm như trên với điều kiện là cột C có giá trị rỗng được không các anh chị. Nghĩa là lọc giá trị rỗng rồi mới đếm các dữ liệu cùng loại trùng nhau.
Cám ơn bạn. Đoạn mã trên làm mình học hỏi rất nhiều

Vậy sửa lại thế này xem sao.

Sub Button1_Click()
Dim count As Long
Dim dupCount As Long
Dim count1 As Long, dem As Long
count = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
count1 = 1
    While count1 <= count
        If (WorksheetFunction.CountIf(Range("B1:" & "B" & count1), Cells(count1, 2)) = 2) And _
        Cells(count1, 3) = "" Then dem = dem + 1
        count1 = count1 + 1
    Wend
MsgBox "Co " & dem & " du lieu trung nhau"
End Sub

 

[VetMini]

Đến đây thì có điều kiện lọc. Tốt hơn là lọc trước sẽ giảm được số lần countif

set rg1 = Range("$B:$B")
set rg2 = Range("$C:$C")
for count1 = 1 to count
  If (rg2.Cells(count1) = "") Then
    If (worksheetfunction.CountIf(rg1.Resize(count1,), rg1.Cells(count1)) = 2) Then dem = dem + 1
  End If
next count1

Tuy nhiên, tôi thấy điều kiện lọc này hơi lạ. Chủ thớt cần xem kỹ lại có đúng ý mình muốn hay không.
Thường thì người ta xét trùng nếu có dũ liệu và bỏ qua trống. Ở đây chủ thớt làm ngược lại.

 

[frantliem]

Nhờ mọi người xem giúp em.

 

[frantliem]

Được rồi. Thanks các bạn