Tính tần suất nhờ VBA (7 người xem)

[QQV586]

Bài toán của thống kê tần suất của 1 giá trị đảo có vài trường hợp đặc biệt, nhờ các bác diễn đàn GPE viết giúp em cái code. Cụ thể thế nào em có gửi file lên đây. Các bác xem qua giúp em.
Em cảm ơn!

 

[huuthang_bd]

Bài toán của thống kê tần suất của 1 giá trị đảo có vài trường hợp đặc biệt, nhờ các bác diễn đàn GPE viết giúp em cái code. Cụ thể thế nào em có gửi file lên đây. Các bác xem qua giúp em.
Em cảm ơn!

Vì sao kết quả ô E7 là 1? Theo cách tính bạn mô tả thì kết quả phải là 3 chứ?

 

[QQV586]

Vì sao kết quả ô E7 là 1? Theo cách tính bạn mô tả thì kết quả phải là 3 chứ?

chuẩn đó bác. là 3 em nhìn không ra.

 

[huuthang_bd]

chuẩn đó bác. là 3 em nhìn không ra.

À, kết quả đúng là 3

Tôi viết cho bạn 1 hàm tự tạo

Function TanSuat(SoKiemTra As String, DuLieu As Range) As Long
If Len(SoKiemTra) <> 2 Then
    TanSuat = 1 / 0
Else
    Dim Cll As Range
    If Left(SoKiemTra, 1) = Right(SoKiemTra, 1) Then
        For Each Cll In DuLieu
            If CStr(Cll.Value) = SoKiemTra Then TanSuat = TanSuat + 1
            If Abs(CLng(SoKiemTra) - CLng(Cll.Value)) = 55 Then TanSuat = TanSuat + 1
        Next
    Else
        For Each Cll In DuLieu
            If CStr(Cll.Value) = SoKiemTra Or CStr(Cll.Value) = StrReverse(SoKiemTra) Then TanSuat = TanSuat + 1
        Next
    End If
End If
End Function

Sử dụng

D5=TanSuat(A5,OFFSET($A$1:$P$1,COLUMN(A5)-1,))

 

[QQV586]

Em cảm ơn bác nhưng chạy có đc đâu bác xem giúp em. em gà mờ quá.

 

[huuthang_bd]

Em cảm ơn bác nhưng chạy có đc đâu bác xem giúp em. em gà mờ quá.

Bạn đã "chạy" như thế nào mà bảo không được?

 

[QQV586]

em thử chạy nhưng nhiều chỗ báo có giá trị =0. Bác xem giúp em gán code vào ấn nút để chạy
Cảm ơn bác!

 

[QQV586]

Hôm trước em coi lại và làm được rồi. Cảm ơn bác huuthang_bd nhé!
Bài toán này có khác so với bài toán trên 1 chút mà em rất dốt mong các bác coi và giúp đỡ em cái code cho phù hợp!
Cảm ơn mọi người quan tâm giúp đỡ!

 

[QQV586]

Các bác vào coi giúp em bài #8 giúp em. Code nào phù hợp với bài toán.
Cảm ơn mọi người quan tâm và giúp đỡ!

 

[gtri]

Các bác vào coi giúp em bài #8 giúp em. Code nào phù hợp với bài toán.
Cảm ơn mọi người quan tâm và giúp đỡ!

Tô màu như file mẫu mới có kết quả đúng

Public Sub TS_Theo_Mau()
Dim Nguon As Range, DoiChieu As Range, kq(), r As Long, rw As Long, c As Long

With Sheet1
Set Nguon = .Range("A1:D4")
Set DoiChieu = .Range("A7:D34")
End With

ReDim kq(1 To DoiChieu.Rows.Count, 1 To DoiChieu.Columns.Count)

For c = 1 To Nguon.Columns.Count
For r = 1 To Nguon.Rows.Count
For rw = 1 To DoiChieu.Rows.Count
If Nguon(r, c).Interior.ColorIndex = DoiChieu(rw, r).Interior.ColorIndex Then
If Nguon(r, c).Value = DoiChieu(rw, r).Value Then
kq(rw, r) = 1
End If
End If
Next rw
Next r
Next c

Sheet1.Range("E7").Resize(UBound(kq), UBound(kq, 2)).ClearContents
Sheet1.Range("E7").Resize(UBound(kq), UBound(kq, 2)) = kq
End Sub

 

[QQV586]

bác gtri ah! em mới đọc chưa chạy được vì em đag sử dụng điện thoại. chưa có máy tính thực nghiệm. nếu như bác bảo chạy theo màu thì chắc k ổn. vì màu em tô để hiển thị cho xem cho đúng. nếu mà các dòng giới hạn đúng theo màu ví dụ màu vàng 10 dòng tiếp màu xanh 10 dòng tiếp, màu đỏ 10 dòng bác xem thế đc không hay cứ phải màu mới đc?

 

[gtri]

bác gtri ah! em mới đọc chưa chạy được vì em đag sử dụng điện thoại. chưa có máy tính thực nghiệm. nếu như bác bảo chạy theo màu thì chắc k ổn. vì màu em tô để hiển thị cho xem cho đúng. nếu mà các dòng giới hạn đúng theo màu ví dụ màu vàng 10 dòng tiếp màu xanh 10 dòng tiếp, màu đỏ 10 dòng bác xem thế đc không hay cứ phải màu mới đc?

Theo màu vì đầu bài không nói rõ là quét mỗi lần bao nhiêu dòng
Nếu cụ thể số dòng cho từng trường hợp sẽ không cần tới màu nữa

 

[Let'GâuGâu]

bác gtri ah! em mới đọc chưa chạy được vì em đag sử dụng điện thoại. chưa có máy tính thực nghiệm. nếu như bác bảo chạy theo màu thì chắc k ổn. vì màu em tô để hiển thị cho xem cho đúng. nếu mà các dòng giới hạn đúng theo màu ví dụ màu vàng 10 dòng tiếp màu xanh 10 dòng tiếp, màu đỏ 10 dòng bác xem thế đc không hay cứ phải màu mới đc?

vùng dữ liệu thống kê phải cách đều nhau nha,
ở đây tôi cho mỗi vùng 9 dòng, bạn có thay đổi thì thay lại số 9 trong code

Sub lamcaigi()
Dim arr, criArr, kq As Variant, i, j, ii, jj As Long, k
criArr = [a1:d4]
ReDim kq(1 To UBound(criArr, 2) * 9, 1 To UBound(criArr))

For i = 1 To UBound(criArr, 2)
    For j = 1 To UBound(criArr)
        arr = Application.Transpose([a7].Resize(9).Offset(ii, jj))
        Do
            k = Application.Match(criArr(j, i), arr, 0)
            If TypeName(k) <> "Error" Then
                arr(k) = ""
                kq(k + ii, j) = 1
            End If
        Loop Until TypeName(k) = "Error"
        jj = jj + 1
    Next
    jj = 0
    ii = ii + 9
Next

[e7:h1000].ClearContents
[e7].Resize(UBound(criArr, 2) * 9, UBound(criArr)) = kq
End Sub

 

[QQV586]

Cảm ơn bác Let'GâuGâu
nhưng khi em thay số lượng 27, hay 63 ,118 đều chạy không ổn có lẽ có giới hạn nào không bác? bác chỉ lối giúp em.
Cảm ơn mọi người đã quan tâm giúp đỡ!

 

[Let'GâuGâu]

Cảm ơn bác Let'GâuGâu
nhưng khi em thay số lượng 27, hay 63 ,118 đều chạy không ổn có lẽ có giới hạn nào không bác? bác chỉ lối giúp em.
Cảm ơn mọi người đã quan tâm giúp đỡ!

thay vào chổ nào, bạn đã cho các vùng cách đều 9 chưa?
thôi bạn up cái file đó lên chỉ chổ nào ko đúng thì nó dể sửa hơn

 

[doveandrose]

ủa rồi các vùng cách nhau số dòng bất kì thì sao ta ? hihi