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

Tuấn Bụng Bự · 14/11/24

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ự · 14/11/24

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 · 14/11/24

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 · 14/11/24

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ự · 14/11/24

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: 14/11/24

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 · 15/11/24

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ự · 15/11/24

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 ạ

huuthang_bd · 15/11/24

Tuấn Bụng Bự đã viết:
Code em vừa test tràn bộ nhớ

Trong trường hợp này tách ra nhiều Dic sẽ cải thiện được tốc độ.

Tuấn Bụng Bự · 15/11/24

huuthang_bd đã viết:
Trong trường hợp này tách ra nhiều Dic sẽ cải thiện được tốc độ.

ram 16Gb , i5 th 11 . chạy đến 10p vẫn chưa ra kết quả xong đơ luôn. chắc em phải nghiên cứu lại code ạ

SA_DQ · 15/11/24

Mình chỉ đi tìm 8 số có trị được lặp lại nhiều nhất trong bảng 20 cột. 100 dòng đó mà thôi;
Bạn có thể tham khảo & phát triển theo í tưởng riêng mình.
Chúc thành công!

Tuấn Bụng Bự · 15/11/24

SA_DQ đã viết:
Mình chỉ đi tìm 8 số có trị được lặp lại nhiều nhất trong bảng 20 cột. 100 dòng đó mà thôi;
Bạn có thể tham khảo & phát triển theo í tưởng riêng mình.
Chúc thành công!

cảm ơn bác để em nghiên cứu. EM thấy cái này hay hay đụng lại toán tổ hợp ngày xưa

cantl · 15/11/24

Bảng 1 gồm:
- Dòng 1: 1 -> 80
- Dòng 2 -> dòng 101: mỗi dòng cứ xuất hiện thì =1, ngược lại là 0.

Bảng 2 gồm:
- Cho dòng 2 = dòng 3, 4, 5, ..., 101.
=> Sum dòng >=8 thì lưu lại 1 cụm >=8 số.

Bảng 3 gồm:
- Từ dòng có sum>=8 tiếp tục cho dòng chính nó = chính nó +1, +2, +3, +....
=> Sum dòng >=8 thì lưu lại 1 cụm >=8 số.

Bảng 4, ..., n (nếu có) thì cách làm giống bảng 3:

Thằng nào tốn nhiều bảng nhất thì là đáp án cuối cùng. Hình như thế!!! Chắc phải dùng code mới nhanh được.

CHAOQUAY · 15/11/24

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 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.

Bộ số này xảy ra 3 lần đầy đủ
19 34 40 41 50 56 67 80
Bạn test thử xem sao

Tuấn Bụng Bự · 16/11/24

cantl đã viết:
Bảng 1 gồm:
- Dòng 1: 1 -> 80
- Dòng 2 -> dòng 101: mỗi dòng cứ xuất hiện thì =1, ngược lại là 0.

Bảng 2 gồm:
- Cho dòng 2 = dòng 3, 4, 5, ..., 101.
=> Sum dòng >=8 thì lưu lại 1 cụm >=8 số.

Bảng 3 gồm:
- Từ dòng có sum>=8 tiếp tục cho dòng chính nó = chính nó +1, +2, +3, +....
=> Sum dòng >=8 thì lưu lại 1 cụm >=8 số.

Bảng 4, ..., n (nếu có) thì cách làm giống bảng 3:

Thằng nào tốn nhiều bảng nhất thì là đáp án cuối cùng. Hình như thế!!! Chắc phải dùng code mới nhanh được.

có lẽ em diễn đạt chưa tốt nên các bác hiểu sai ý em, để em nghiên cứu diễn đạt, trong thời gian đó bác có thể xem file và bộ số ví dụ giúp em ạ

Bài đã được tự động gộp: 16/11/24

CHAOQUAY đã viết:
Bộ số này xảy ra 3 lần đầy đủ
19 34 40 41 50 56 67 80
Bạn test thử xem sao

bộ số trên không xuất hiện đầy đủ ở bất cứ hàng nào cả bác ạ

SA_DQ · 16/11/24

PHP:

Dim Tmr As Double
Sub Tao20SoNgauBeHon81()    'Ctrl+Shift+N'
 Dim W As Integer, SoNgau As Integer, Hg As Integer
 Dim Tmp As String, sTp As String
 
 Tmr = Timer()
1 For W = 1 To 80    'Vòng Lap Tao Chuoi Cua 80 Sô    '
    Tmp = Tmp & Right("0" & CStr(W), 2)
 Next W
 Randomize
2 ' Vong Lap Tao Lai 1 Nua Sô Hàng Mà Môi Hàng 20 Sô Không Lap   '
 For Hg = IIf(Day(Date) Mod 2 = 0, 4, 3) To 102 Step 2
    sTp = Tmp:                      ReDim Arr(1 To 1, 1 To 20)
    For W = 1 To 20
        SoNgau = 3 + 35 * Rnd() \ 1
        If SoNgau Mod 2 = 0 Then SoNgau = SoNgau + 1
        Arr(1, W) = Mid$(sTp, SoNgau, 2)
        Tmp = Mid(sTp, SoNgau + 2, Len(sTp)) & Left(sTp, SoNgau - 2)
    Next W
    Cells(Hg, "A").Resize(, 20).Value = Arr()
'    Erase Arr()    '
 Next Hg
 SapXep
 TimKiem
 MsgBox Timer() - Tmr
End Sub

Mã:

Sub TimKiem()
 Dim Arr(), Rng As Range, sRng As Range, Rg0 As Range, Cls As Range
 Dim W As Integer, J As Integer, Dem As Integer, Num As Integer, Tmr As Double, Max_ As Integer
 
 [U3:U102].Clear
 For J = 102 To 3 Step -1
    Set Rng = Cells(J, "A").Resize(, 20)
    For Each Cls In [W2:W9]
        Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then Dem = Dem + 1
    Next Cls
    If Dem > Max_ Then
        Cells(J, "J").Interior.ColorIndex = 34 + Dem
        Cells(J, "U").Value = Dem:  Max_ = Dem
    End If
    Dem = 0
 Next J
End Sub

PHP:

Sub SapXep() ' Keyboard Shortcut: Ctrl+Shift+X'
 Columns("W:X").Select
 ActiveWorkbook.Worksheets("DuLieu").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("DuLieu").Sort.SortFields.Add2 Key:=Range("X2:X103" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
 With ActiveWorkbook.Worksheets("DuLieu").Sort
    .SetRange Range("W1:X103"):     .Header = xlYes
    .MatchCase = False:             .Orientation = xlTopToBottom
    .SortMethod = xlPinYin:         .Apply
 End With
End Sub

Phuocam · 16/11/24

Tuấn Bụng Bự đã viết:
bộ số trên không xuất hiện đầy đủ ở bất cứ hàng nào cả bác ạ

Bạn kiểm tra cách nào vậy?

Nhập 8 số trên vào AE9:AL9, kết quả là 3. Hàng có bộ số này là: 11, 20, 54.

CHAOQUAY · 16/11/24

Tuấn Bụng Bự đã viết:
có lẽ em diễn đạt chưa tốt nên các bác hiểu sai ý em, để em nghiên cứu diễn đạt, trong thời gian đó bác có thể xem file và bộ số ví dụ giúp em ạ

Bài đã được tự động gộp: 16/11/24

bộ số trên không xuất hiện đầy đủ ở bất cứ hàng nào cả bác ạ

Giả sử bộ số xuất hiện tại nhiều hàng, kết quả mong đợi của bạn là thế nào?

Tuấn Bụng Bự · 16/11/24

CHAOQUAY đã viết:
Bộ số này xảy ra 3 lần đầy đủ
19 34 40 41 50 56 67 80
Bạn test thử xem sao

Đúng rồi bác.
Xin lỗi hôm qua em test chưa kỹ ạ.
Cái em cần là chứng minh bộ số xảy ra 3 lần này là lớn nhất rồi, ko có cái nào trùng 3 lần hoặc hơn ạ.

Bài đã được tự động gộp: 16/11/24

SA_DQ đã viết:

PHP:

Dim Tmr As Double
Sub Tao20SoNgauBeHon81()    'Ctrl+Shift+N'
 Dim W As Integer, SoNgau As Integer, Hg As Integer
 Dim Tmp As String, sTp As String
 
 Tmr = Timer()
1 For W = 1 To 80    'Vòng Lap Tao Chuoi Cua 80 Sô    '
    Tmp = Tmp & Right("0" & CStr(W), 2)
 Next W
 Randomize
2 ' Vong Lap Tao Lai 1 Nua Sô Hàng Mà Môi Hàng 20 Sô Không Lap   '
 For Hg = IIf(Day(Date) Mod 2 = 0, 4, 3) To 102 Step 2
    sTp = Tmp:                      ReDim Arr(1 To 1, 1 To 20)
    For W = 1 To 20
        SoNgau = 3 + 35 * Rnd() \ 1
        If SoNgau Mod 2 = 0 Then SoNgau = SoNgau + 1
        Arr(1, W) = Mid$(sTp, SoNgau, 2)
        Tmp = Mid(sTp, SoNgau + 2, Len(sTp)) & Left(sTp, SoNgau - 2)
    Next W
    Cells(Hg, "A").Resize(, 20).Value = Arr()
'    Erase Arr()    '
 Next Hg
 SapXep
 TimKiem
 MsgBox Timer() - Tmr
End Sub

Mã:

Sub TimKiem()
 Dim Arr(), Rng As Range, sRng As Range, Rg0 As Range, Cls As Range
 Dim W As Integer, J As Integer, Dem As Integer, Num As Integer, Tmr As Double, Max_ As Integer
 
 [U3:U102].Clear
 For J = 102 To 3 Step -1
    Set Rng = Cells(J, "A").Resize(, 20)
    For Each Cls In [W2:W9]
        Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then Dem = Dem + 1
    Next Cls
    If Dem > Max_ Then
        Cells(J, "J").Interior.ColorIndex = 34 + Dem
        Cells(J, "U").Value = Dem:  Max_ = Dem
    End If
    Dem = 0
 Next J
End Sub

PHP:

Sub SapXep() ' Keyboard Shortcut: Ctrl+Shift+X'
 Columns("W:X").Select
 ActiveWorkbook.Worksheets("DuLieu").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("DuLieu").Sort.SortFields.Add2 Key:=Range("X2:X103" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
 With ActiveWorkbook.Worksheets("DuLieu").Sort
    .SetRange Range("W1:X103"):     .Header = xlYes
    .MatchCase = False:             .Orientation = xlTopToBottom
    .SortMethod = xlPinYin:         .Apply
 End With
End Sub

Cảm ơn bác đã nhiệt tình code.
Nhưng xin cho em hỏi câu hơi ngu là bác giải thích 3 chương trình trên mục đích gì hộ em được không ạ

SA_DQ · 16/11/24

Macro trên cùng có 2 nhiệm vụ:
1 là Tạo 1 chuỗi chứa các số từ 01,02. . . 80;
Tạo 1 vòng lặp trích ra từ chuỗi vừa tạo 20 số (không trùng cho từng hàng chẵn hay lẽ phụ thuộc theo ngày;
Macro 2: Tìm kiếm theo từng hàng 8 con số nhiếu nhất trong bảng có bao nhiêu số & ghi nhận lại
Macro 3 : Sắp xếp theo chiều giảm dần của các số trùng lặp nhiều nhất (Macro nhờ bộ thu của VBE)

CHAOQUAY · 16/11/24

Tuấn Bụng Bự đã viết:
Đúng rồi bác.
Xin lỗi hôm qua em test chưa kỹ ạ.
Cái em cần là chứng minh bộ số xảy ra 3 lần này là lớn nhất rồi, ko có cái nào trùng 3 lần hoặc hơn ạ.

Bài đã được tự động gộp: 16/11/24

Cảm ơn bác đã nhiệt tình code.
Nhưng xin cho em hỏi câu hơi ngu là bác giải thích 3 chương trình trên mục đích gì hộ em được không ạ

Cái này chứng minh loại trừ cũng dễ mà bạn


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)

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

Người dùng đang xem chủ đề này

Gà VBA - 0856 120 789

File đính kèm

Gà VBA - 0856 120 789

Thành viên mới

Bad Excel Member

Gà VBA - 0856 120 789

Chuyên gia GPE

Gà VBA - 0856 120 789

Chuyên gia GPE

Gà VBA - 0856 120 789

/(hông là gì!

File đính kèm

Gà VBA - 0856 120 789

!!! Giải thoát !!!

Thành viên gắn bó

Gà VBA - 0856 120 789

/(hông là gì!

Thành viên mới

Thành viên gắn bó

Gà VBA - 0856 120 789

/(hông là gì!

Thành viên gắn bó

Đếm ngược thời gian