Tính tần suất xuất hiện của một số giá trị dựa vào VBA (1 người xem)

[DanTri007]

Bài toán của em là tính tần suất của giá trị dựa vào số lần xuất hiện.
B1:so sánh hàng với cột, ví dụ hàng (a1:r1) với cột (a12:a207). Có sự xuất hiện của số nào điền số ấy với số lần này lặp tối đa nếu có, còn không thì bỏ trống ô chứa số đó thuộc
B2: Điền kết quả sau khi so sánh(như ví dụ mẫu). Em có gửi file theo kèm
Nhờ các bác viết code VBA để chạy cho chính xác.

Cảm ơn mọi người đã quan tâm và giúp đỡ

Thanks GPE!

 

[SA_DQ]

Đây, macro của bạn & những mong là khỏi gởi file lên!

Option Explicit
Sub gpeTinhTrung()
 Dim J As Long, Z As Byte, Dem As Byte
 Dim Rng As Range, sRng As Range
 Dim fAdd As String
 For J = 12 To [A12].End(xlDown).Row
    For Z = 1 To 10
        Set Rng = Cells(Z, "A").Resize(, Cells(Z, "A").End(xlToRight).Column)
        Set sRng = Rng.Find(Cells(J, Z), , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then
            fAdd = sRng.Address
            Do
                Dem = Dem + 1
                Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> fAdd
        End If
        If Dem > 0 Then
            Cells(J, Z).Offset(, 11).Value = Dem:               Dem = 0
        End If
    Next Z
 Next J
End Sub

 

[Quang_Hải]

Bài toán của em là tính tần suất của giá trị dựa vào số lần xuất hiện.
B1:so sánh hàng với cột, ví dụ hàng (a1:r1) với cột (a12:a207). Có sự xuất hiện của số nào điền số ấy với số lần này lặp tối đa nếu có, còn không thì bỏ trống ô chứa số đó thuộc
B2: Điền kết quả sau khi so sánh(như ví dụ mẫu). Em có gửi file theo kèm
Nhờ các bác viết code VBA để chạy cho chính xác.

Cảm ơn mọi người đã quan tâm và giúp đỡ

Thanks GPE!

Thêm 1 sự chọn lựa cho bạn

Sub SoSanh()
Dim Bang1(), Bang2(), Kq()
Dim Dong As Long, Cot  As Long, CotDong  As Long
Bang1 = [A1:R10].Value
Bang2 = [A12:J207].Value
ReDim Kq(1 To UBound(Bang2), 1 To UBound(Bang2, 2))
For Dong = 1 To UBound(Bang2)
    For Cot = 1 To UBound(Bang2, 2)
        For CotDong = 1 To UBound(Bang1, 2)
            If Bang1(Cot, CotDong) = Bang2(Dong, Cot) Then
                Kq(Dong, Cot) = Kq(Dong, Cot) + 1
            End If
        Next
    Next
Next
[W12].Resize(Dong - 1, Cot - 1) = Kq
End Sub

Hình như bài này dùng công thức cũng ra kết quả tương tự
tại L12 bạn nhập công thức này vào rồi kéo ngang, kéo dọc xem sao
=COUNTIF(INDIRECT("A"& COLUMN(A:A)&":R"&COLUMN(A:A)),$A12)

 

[DanTri007]

Thanks mọi người quan tâm và giúp đỡ. Cảm ơn bạn HYen17, Code của bác quanghai1969 chạy nhanh chuẩn rồi.
Bác Quanghai1969 cho em hỏi và nhờ bác cùng mọi giải đáp giúp em. Cùng bài toán trên, em muốn tính tần suất của một cặp số đối nhau ví dụ như( sự xuất hiện 05,50 hoặc 56,65 ) nếu hàng có xuất hiện 05 1 lần mà 50 3 lần thì ô chứa 05 hoặc 50 trong cột sẽ điền tần suất là 4, còn nếu không xuất hiện thì bỏ qua.
Thanks GPE!

 

[Quang_Hải]

Thanks mọi người quan tâm và giúp đỡ. Cảm ơn bạn HYen17, Code của bác quanghai1969 chạy nhanh chuẩn rồi.
Bác Quanghai1969 cho em hỏi và nhờ bác cùng mọi giải đáp giúp em. Cùng bài toán trên, em muốn tính tần suất của một cặp số đối nhau ví dụ như( sự xuất hiện 05,50 hoặc 56,65 ) nếu hàng có xuất hiện 05 1 lần mà 50 3 lần thì ô chứa 05 hoặc 50 trong cột sẽ điền tần suất là 4, còn nếu không xuất hiện thì bỏ qua.
Thanks GPE!

Cốc có hiểu, bài trên mình code được là nhờ có cái mô tả kết quả tạm, nếu không có cái kết quả tạm đó thì bó tay thôi.

 

[VetMini]

Thanks mọi người quan tâm và giúp đỡ. Cảm ơn bạn HYen17, Code của bác quanghai1969 chạy nhanh chuẩn rồi.
Bác Quanghai1969 cho em hỏi và nhờ bác cùng mọi giải đáp giúp em. Cùng bài toán trên, em muốn tính tần suất của một cặp số đối nhau ví dụ như( sự xuất hiện 05,50 hoặc 56,65 ) nếu hàng có xuất hiện 05 1 lần mà 50 3 lần thì ô chứa 05 hoặc 50 trong cột sẽ điền tần suất là 4, còn nếu không xuất hiện thì bỏ qua.
Thanks GPE!

Cái cặp này lấy ở đâu ra?

 

[DanTri007]

em gửi file theo kèm các bác coi, lấy hàng so sánh cột. lấy giá trị ô thuộc cột so sánh với hàng, gọi là đối xứng như sau cặp ấy 05,50 hoặc 56,65..
file ví dụ em gửi các bác coi giúp em.
Thanks GPE!

 

[Quang_Hải]

em gửi file theo kèm các bác coi, lấy hàng so sánh cột. lấy giá trị ô thuộc cột so sánh với hàng, gọi là đối xứng như sau cặp ấy 05,50 hoặc 56,65..
file ví dụ em gửi các bác coi giúp em.
Thanks GPE!

Phải thế này không? Nhìn rừng số ớn lạnh quá. Trúng thì tốt, mà lỡ trật thì thôi mình vọt nha. Sạch sẽ rồi.

Sub SoSanh()
Dim Bang1(), Bang2(), Kq()
Dim Dong As Long, Cot  As Long, CotDong  As Long
Bang1 = [A1:R10].Value
Bang2 = [A12:J207].Value
ReDim Kq(1 To UBound(Bang2), 1 To UBound(Bang2, 2))
For Dong = 1 To UBound(Bang2)
    For Cot = 1 To UBound(Bang2, 2)
        For CotDong = 1 To UBound(Bang1, 2)
            If Bang1(Cot, CotDong) = Bang2(Dong, Cot) _
            Or StrReverse(Bang1(Cot, CotDong)) = Bang2(Dong, Cot) Then
                Kq(Dong, Cot) = Kq(Dong, Cot) + 1
            End If
        Next
    Next
Next
[W12].Resize(Dong - 1, Cot - 1) = Kq
End Sub

 

[VetMini]

Dùng code ở bài số #3.

Thay dòng này:

If Bang1(Cot, CotDong) = Bang2(Dong, Cot) Then

Bằng 2 dòng này:

If Bang2(Dong, Cot) = Bang1(Cot, CotDong) _
Or Bang2(Dong, Cot) = StrReversei(Bang1(Cot, CotDong)) Then

=== trế rồi, tác giả code đã đi trước ===

 

[DanTri007]

Bác quanghai1969 và bác vietmini coi lại code bài #8,#9 giúp em cho yêu cầu bài số #4 mà chạy code trên đâu đúng..
thanks bác và GPE!

 

[Quang_Hải]

Bác quanghai1969 và bác vietmini coi lại code bài #8,#9 giúp em cho yêu cầu bài số #4 mà chạy code trên đâu đúng..
thanks bác và GPE!

Mình chạy thôi, hết thuốc rồi. Hy vọng có code khác đúng ý để mình học hỏi. Bài toán khó quá.

 

[Ba Tê]

Bác quanghai1969 và bác vietmini coi lại code bài #8,#9 giúp em cho yêu cầu bài số #4 mà chạy code trên đâu đúng..
thanks bác và GPE!

Thử chạy code "Xi ma chao" này coi sao. Thấy dài dòng lu bu quá.
Vái "Chời" không phải dùng cho "bao lô"!
[GPECODE=vb]Public Sub XaoMaChi()
Dim rArr(), cArr(), dArr(), I As Long, M As Long, N As Long, K As Long
Dim Dic As Object, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
rArr = .Range("A1:R10").Value2
cArr = .Range("A12:J207").Value2
ReDim dArr(1 To UBound(cArr, 1), 1 To UBound(cArr, 2))
For N = 1 To UBound(rArr, 1)
For M = 1 To UBound(rArr, 2)
Tem = rArr(N, M)
If Right(rArr(N, M), 1) < Left(rArr(N, M), 1) Then Tem = Right(rArr(N, M), 1) & Left(rArr(N, M), 1)
If Not Dic.Exists(Tem) Then
Dic.Add Tem, 1
Else
Dic.Item(Tem) = Dic.Item(Tem) + 1
End If
Next M
For I = 1 To UBound(cArr, 1)
Tem = cArr(I, N)
If Right(cArr(I, N), 1) < Left(cArr(I, N), 1) Then Tem = Right(cArr(I, N), 1) & Left(cArr(I, N), 1)
If Dic.Exists(Tem) Then dArr(I, N) = Dic.Item(Tem)
Next I
Dic.RemoveAll
Next N
.[L12].Resize(UBound(cArr, 1), UBound(cArr, 2)) = dArr
End With
Set Dic = Nothing
End Sub
[/GPECODE]

 

[Quang_Hải]

Thử chạy code "Xi ma chao" này coi sao. Thấy dài dòng lu bu quá.
Vái "Chời" không phải dùng cho "bao lô"!

[/GPECODE]

Bảo đảm anh và em đi chung 1 đường rồi, code chạy ra kết quả giống nhau y chang. Chúc mừng anh... he he

 

[Ba Tê]

Bảo đảm anh và em đi chung 1 đường rồi, code chạy ra kết quả giống nhau y chang. Chúc mừng anh... he he

Chúc mừng thì "đi nhậu" thôi, tác giả nói "hổng trúng"! Ẹc..

 

[DanTri007]

Đến giờ chuẩn rồi bác. lúc em chạy mãi vẫn k ok. Cảm ơn các bác Bate, Quanghai1969, Vietmini, HYen17!!!!!

Thanks GPE!