đếm số lần kết quả trùng

[Sơn Mã]

Mong GPE và các bạn xem giúp mình trường hợp này với ạ:
Dữ liệu ở sheet3 gồm cột thời điểm kiểm tra và số liệu ở cột B và C làm mẫu đối chiếu.
Sheet4 là các kết quả tại cùng 1 thời điểm (mỗi kết quả là 2 cột dữ liệu) đếm xem có bao nhiêu trường hợp kết quả trùng với kết quả ở sheet3 => kết quả đếm được dán vào cột D sheet3.

ví dụ:
trong file ở sheet4:
- tại thời điểm 00:01:00 có 7 trường hợp trùng kết quả ở sheet3
- tại thời điểm 00:02:00 có 3 trường hợp trùng kết quả ở sheet3
- tại thời điểm 00:03:00 có 2 trường hợp trùng kết quả ở sheet3
- tại thời điểm 00:04:00 có 5 trường hợp trùng với kết quả ở sheet3
- tại thời điểm 00:05:00 có 4 trường hợp trùng với kết quả ở sheet3
+ kết quả ở sheet3 có dạng là a b thì ở sheet4 kết quả dạng a b và b a vẫn tính là trùng với kết quả ở sheet3
Mong các bạn giúp đỡ. Chân thành cảm ơn các bạn rất nhiều!
Đây là file minh hoạ: https://drive.google.com/file/d/0Bx2f8EmKQT9bQ2pfUENOM0twNGs/view?usp=sharing

 

[TheThienChu]

Một cách tiều phu đốn củi.
Không xét tốc độ vì không biết kích cỡ dữ liệu.
Xem cho qua ngày đoạn tháng trong lúc chờ các cao nhân xuất hiện.

Sub BAOGIOMOIDEMXONG()
Dim SArr, Cnd, Res
Dim i, j, tm
Dim DicD As Object
tm = Timer
Set DicD = CreateObject("Scripting.Dictionary")

SArr = Sheet4.Range("A1").CurrentRegion
Cnd = Sheet3.Range("A2", Sheet3.Range("C1000000").End(xlUp))
ReDim Res(1 To UBound(Cnd), 1 To 1)
For j = 1 To UBound(SArr, 2) Step 3
    For i = 2 To UBound(SArr)
        DicD(SArr(i, j) & SArr(i, j + 1) & SArr(i, j + 2)) = DicD(SArr(i, j) & SArr(i, j + 1) & SArr(i, j + 2)) + 1
    Next i
Next j
For i = 1 To UBound(Cnd)
    If Cnd(i, 2) = Cnd(i, 3) Then
        Res(i, 1) = DicD(Cnd(i, 1) & Cnd(i, 2) & Cnd(i, 3))
    Else
        Res(i, 1) = DicD(Cnd(i, 1) & Cnd(i, 2) & Cnd(i, 3)) + DicD(Cnd(i, 1) & Cnd(i, 3) & Cnd(i, 2))
    End If
Next i
Sheet3.Range("D2:D1441").ClearContents
Sheet3.Range("D2:D1441") = Res
Sheet3.Range("E1") = Timer - tm
Beep
End Sub

 

[Sơn Mã]

Một cách tiều phu đốn củi.
Không xét tốc độ vì không biết kích cỡ dữ liệu.
Xem cho qua ngày đoạn tháng trong lúc chờ các cao nhân xuất hiện.

Sub BAOGIOMOIDEMXONG()
Dim SArr, Cnd, Res
Dim i, j, tm
Dim DicD As Object
tm = Timer
Set DicD = CreateObject("Scripting.Dictionary")

SArr = Sheet4.Range("A1").CurrentRegion
Cnd = Sheet3.Range("A2", Sheet3.Range("C1000000").End(xlUp))
ReDim Res(1 To UBound(Cnd), 1 To 1)
For j = 1 To UBound(SArr, 2) Step 3
    For i = 2 To UBound(SArr)
        DicD(SArr(i, j) & SArr(i, j + 1) & SArr(i, j + 2)) = DicD(SArr(i, j) & SArr(i, j + 1) & SArr(i, j + 2)) + 1
    Next i
Next j
For i = 1 To UBound(Cnd)
    If Cnd(i, 2) = Cnd(i, 3) Then
        Res(i, 1) = DicD(Cnd(i, 1) & Cnd(i, 2) & Cnd(i, 3))
    Else
        Res(i, 1) = DicD(Cnd(i, 1) & Cnd(i, 2) & Cnd(i, 3)) + DicD(Cnd(i, 1) & Cnd(i, 3) & Cnd(i, 2))
    End If
Next i
Sheet3.Range("D2:D1441").ClearContents
Sheet3.Range("D2:D1441") = Res
Sheet3.Range("E1") = Timer - tm
Beep
End Sub

Cảm ơn bạn rất nhiều ạ! Xin cảm ơn bạn!