Cần giúp đỡ về Code (1 người xem)

[meacupa]

Hi all.

Hiện tại mình có một bài toán về thống kê( như file đính kèm) đã xử lý được phần đầu, giờ mình muốn phát triển lên nhưng lại không biết cách làm. Rất mong được mọi người giúp đỡ.
Many thanks

 

[meacupa]

Hix. Không có Pro nào ra tay giúp mình ah

 

[chucuoi92]

Hix. Không có Pro nào ra tay giúp mình ah

Code trong file là của anh concogia đúng vậy không

Mình sửa tạm thế này nhé, muốn hay hơn thì phải đợi anh ấy thôi.

Public Sub test()
Dim Vung, VungDo, I, J, K, kK, Kq, Gom, Tong
Set Vung = Range([a1], [a10000].End(xlUp))
VungDo = Range([q1], [q10000].End(xlUp)).Resize(, 8)
ReDim Kq(1 To Vung.Rows.Count, 1 To 2)
For I = 1 To Vung.Rows.Count
Gom = Vung(I)
kK = kK + 1
For J = I + 1 To UBound(VungDo, 1)
For K = 1 To UBound(VungDo, 2)
If InStr(Gom, VungDo(J, K)) Then Tong = Tong + 1
Next K
If IsEmpty(Tong) Then
Tong = 0
End If
Kq(kK, 1) = Tong
Tong = 0: Exit For
Next J
Next I
[i1].Resize(kK, 1) = Kq
End Sub

 

[meacupa]

Đúng rồi bạn ah
Cảm ơn bạn nhiều
Bạn ơi đây vẫn là code cũ mà

 

[SA_DQ]

Thử cái ni coi sao?

Sub ConCoGiaBienThe()
 Dim Rng As Range, Arr()
 Dim Hg As Long, Cot As Byte, J As Long

 Set Rng = [B2].CurrentRegion
 Arr() = [Q2].CurrentRegion.Value
 ReDim dArr(1 To Rng.Rows.Count, 1 To Rng.Columns.Count) As Integer
 For Cot = 1 To Rng.Columns.Count
    For Hg = 1 To Rng.Rows.Count
        For J = 1 To UBound(Arr(), 2)
            If Cells(Hg, Cot).Value = Arr(Hg, J) Then
                dArr(Hg, Cot) = dArr(Hg, Cot) + 1
            End If
        Next J
    Next Hg
 Next Cot
 [i1].Resize(Hg - 1, Cot - 1) = dArr()
End Sub

 

[meacupa]

Cảm ơn bạn nhiều
Mình sẽ dùng xem sao