Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)

Tuấn Bụng Bự · Hôm qua, lúc 19:11

Chào các bác !
Em có 1 bài toán khó nhờ các bác bắt bệnh xem có thế code VBA giải quyết được không ạ !?

Input:
- bảng dữ liệu A3:T102 gồm 20 cột và 100 hàng
- Dữ liệu trong bảng là random từ 1 - 80 và mỗi hàng các số không lặp lại

Output:
Tìm ra 8 bộ số mà nó xuất hiện đồng thời trong 1 hàng và nó xuất hiện ở nhiều hàng nhất

Bộ số ví dụ ( không phải kết quả)	47	25	62	61	34	70	64	30
Số lần xuất hiện 8 bộ số này đồng thời trong mỗi hàng là 1 lần (chỉ ở hàng 3)

Xin cảm ơn các bác đã đọc bài.

Tuấn Bụng Bự · Hôm qua, lúc 20:47

tổ hợp 8 số trong 80 số nó ra gần 29 tỷ kết quả

vậy bài toán này có khả thi không ? xin nhờ các cao nhân ạ

Phuocam · Hôm qua, lúc 20:54

Tuấn Bụng Bự đã viết:
tổ hợp 8 số trong 80 số nó ra gần 29 tỷ kết quả
vậy bài toán này có khả thi không ? xin nhờ các cao nhân ạ

Mỗi hàng có 20 số, COMBIN(20,8) => 125.970

100 hàng có 125.970 x 100 = 12.597.000 kết hợp, không cần tính 29 tỷ .

ptm0412 · Hôm qua, lúc 21:10

Tuấn Bụng Bự đã viết:
Tìm ra cặp 8 số mà nó xuất hiện đồng thời trong 1 hàng và nó xuất hiện ở nhiều hàng nhất

Số lần xuất hiện 8 cặp số này đồng thời trong mỗi hàng là 1 lần (chỉ ở hàng 3)

Cặp số (hoặc bất kỳ cặp gì) chỉ có 2 số, không có cặp 8
8 cặp số là 16 số.

Nếu không kể đến vụ hoán vị nghĩa là cùng 8 con số nhưng nằm vị trí khác nhau trong cột, sẽ tính riêng (tức là coi như không giống nhau) thì nối 8 con lại và đếm trùng
Nếu có cho phép hoán vị và tính là giống nhau, thì sort từng dòng từ nhỏ đến lớn xong nối lại, tiếp tục đếm trùng.

Có vẻ bài này giống thống kê xổ số nên tôi chỉ nói đến vậy thôi.

Tuấn Bụng Bự · Hôm qua, lúc 21:33

Phuocam đã viết:
Mỗi hàng có 20 số, COMBIN(20,8) => 125.970

100 hàng có 125.970 x 100 = 12.597.000 kết hợp, không cần tính 29 tỷ .

oh ý kiến của bác hay, giảm số lần xét
mong nhận thêm ý kiến của bác về cách code ra lời giải

Bài đã được tự động gộp: Hôm qua, lúc 21:35

ptm0412 đã viết:
Cặp số (hoặc bất kỳ cặp gì) chỉ có 2 số, không có cặp 8
8 cặp số là 16 số.

Nếu không kể đến vụ hoán vị nghĩa là cùng 8 con số nhưng nằm vị trí khác nhau trong cột, sẽ tính riêng (tức là coi như không giống nhau) thì nối 8 con lại và đếm trùng
Nếu có cho phép hoán vị và tính là giống nhau, thì sort từng dòng từ nhỏ đến lớn xong nối lại, tiếp tục đếm trùng.

Có vẻ bài này giống thống kê xổ số nên tôi chỉ nói đến vậy thôi.

vâng, câu chữ của em có thể chưa chuẩn nên em có để ví dụ :

47

25

62

61

34

70

64

30

có thể em nên sửa lại là bộ 8 số lấy trong khoảng từ 1 đến 80

HieuCD · Hôm nay lúc 00:00

Tuấn Bụng Bự đã viết:
Chào các bác !
Em có 1 bài toán khó nhờ các bác bắt bệnh xem có thế code VBA giải quyết được không ạ !?

Input:
- bảng dữ liệu A3:T102 gồm 20 cột và 100 hàng
- Dữ liệu trong bảng là random từ 1 - 80 và mỗi hàng các số không lặp lại

Output:
Tìm ra cặp 8 số mà nó xuất hiện đồng thời trong 1 hàng và nó xuất hiện ở nhiều hàng nhất

Cặp số ví dụ ( không phải kết quả)
47
25
62
61
34
70
64
30
Số lần xuất hiện 8 cặp số này đồng thời trong mỗi hàng là 1 lần (chỉ ở hàng 3)

Xin cảm ơn các bác đã đọc bài.

Chay code xyz . . . .

Mã:

Option Explicit

Sub xyz()
  Dim arr(), a, dic As Object
  Dim sR&, sC&, sR2&, i&, r&, k&, n&, j&, iMax&, t$, res$
 
  Set dic = CreateObject("scripting.dictionary")
  arr = Range("A3:T102").Value
  sR = UBound(arr):     sC = UBound(arr, 2)
  k = 8
  Call aSort(arr, sR, sC&, 80)
  a = Tohop_N_Chap_K(sC, k)
  sR2 = UBound(a)
  For i = 1 To sR
    For r = 1 To sR2
      t = arr(i, a(r, 1))
      For j = 2 To k
        t = t & "," & arr(i, a(r, j))
      Next j
      n = dic(t) + 1
      dic(t) = n
      If iMax < n Then
        iMax = n
        res = t
      End If
    Next r
  Next i
  Range("X6") = res
  Range("X7") = iMax
End Sub

Private Sub aSort(arr, sR, sC, ByVal n&)
  Dim a&(), i&, j&, c&
 
  For i = 1 To sR
    ReDim a(1 To n): c = 0
    For j = 1 To sC
      a(arr(i, j)) = 1
    Next j
    For j = 1 To n
      If a(j) = 1 Then
        c = c + 1
        arr(i, c) = j
      End If
    Next j
  Next i
End Sub

Private Function Tohop_N_Chap_K(ByVal n As Integer, ByVal k As Integer) As Variant
  Dim arr(), tmp$, sR&, i&, j&, p&, s&
  'Tao to hop N chap K, bieu dien bang chuoi các k? tu "0" va "1"
  'Thu tu gia tri "1" là thu tu du lieu nguon lay du lieu
  sR = Application.Combin(n, k)
  ReDim arr(1 To Application.Combin(n, k), 1 To k)
  tmp = String(k, "1") & String(n - k, "0")
  p = 1: arr(p, 1) = tmp
  Do
    j = InStrRev(tmp, "1")
    Mid(tmp, j, 1) = "0"
    Mid(tmp, j + 1, s + 1) = String(s + 1, "1")
    s = 0: p = p + 1:   arr(p, 1) = tmp
    If InStr(j + 1, tmp, "0") = 0 Then
      s = n - j
      Mid(tmp, j + 1, s) = String(s, "0")
    End If
  Loop Until s = k
  'Tao mang to hop N chap K, gia tri mang là thu tu cot lay du lieu tu mang nguon
  For i = 1 To sR
    tmp = arr(i, 1):    p = 0
    For j = 1 To n
      If Mid(tmp, j, 1) = "1" Then
        p = p + 1
        arr(i, p) = j
      End If
    Next j
  Next i
  Tohop_N_Chap_K = arr
End Function

Tuấn Bụng Bự · Hôm nay lúc 00:08

HieuCD đã viết:

Chay code xyz . . . .

Mã:

Option Explicit

Sub xyz()
  Dim arr(), a, dic As Object
  Dim sR&, sC&, sR2&, i&, r&, k&, n&, j&, iMax&, t$, res$
 
  Set dic = CreateObject("scripting.dictionary")
  arr = Range("A3:T102").Value
  sR = UBound(arr):     sC = UBound(arr, 2)
  k = 8
  Call aSort(arr, sR, sC&, 80)
  a = Tohop_N_Chap_K(sC, k)
  sR2 = UBound(a)
  For i = 1 To sR
    For r = 1 To sR2
      t = arr(i, a(r, 1))
      For j = 2 To k
        t = t & "," & arr(i, a(r, j))
      Next j
      n = dic(t) + 1
      dic(t) = n
      If iMax < n Then
        iMax = n
        res = t
      End If
    Next r
  Next i
  Range("X6") = res
  Range("X7") = iMax
End Sub

Private Sub aSort(arr, sR, sC, ByVal n&)
  Dim a&(), i&, j&, c&
 
  For i = 1 To sR
    ReDim a(1 To n): c = 0
    For j = 1 To sC
      a(arr(i, j)) = 1
    Next j
    For j = 1 To n
      If a(j) = 1 Then
        c = c + 1
        arr(i, c) = j
      End If
    Next j
  Next i
End Sub

Private Function Tohop_N_Chap_K(ByVal n As Integer, ByVal k As Integer) As Variant
  Dim arr(), tmp$, sR&, i&, j&, p&, s&
  'Tao to hop N chap K, bieu dien bang chuoi các k? tu "0" va "1"
  'Thu tu gia tri "1" là thu tu du lieu nguon lay du lieu
  sR = Application.Combin(n, k)
  ReDim arr(1 To Application.Combin(n, k), 1 To k)
  tmp = String(k, "1") & String(n - k, "0")
  p = 1: arr(p, 1) = tmp
  Do
    j = InStrRev(tmp, "1")
    Mid(tmp, j, 1) = "0"
    Mid(tmp, j + 1, s + 1) = String(s + 1, "1")
    s = 0: p = p + 1:   arr(p, 1) = tmp
    If InStr(j + 1, tmp, "0") = 0 Then
      s = n - j
      Mid(tmp, j + 1, s) = String(s, "0")
    End If
  Loop Until s = k
  'Tao mang to hop N chap K, gia tri mang là thu tu cot lay du lieu tu mang nguon
  For i = 1 To sR
    tmp = arr(i, 1):    p = 0
    For j = 1 To n
      If Mid(tmp, j, 1) = "1" Then
        p = p + 1
        arr(i, p) = j
      End If
    Next j
  Next i
  Tohop_N_Chap_K = arr
End Function

Cảm ơn bác đã đọc và hỗ trợ
Code em vừa test tràn bộ nhớ. để mai em mượn máy bạn test lại ạ

Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)

Tuấn Bụng Bự

Gà VBA

File đính kèm

Tuấn Bụng Bự

Gà VBA

Phuocam

Thành viên mới

ptm0412

Bad Excel Member

Tuấn Bụng Bự

Gà VBA

HieuCD

Chuyên gia GPE

Tuấn Bụng Bự

Gà VBA

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng


Số lần xuất hiện 8 cặp số này đồng thời trong mỗi hàng là 1 lần (chỉ ở hàng 3)

Cặp số ví dụ ( không phải kết quả)	47	25	62	61	34	70	64	30
Số lần xuất hiện 8 cặp số này đồng thời trong mỗi hàng là 1 lần (chỉ ở hàng 3)