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

Gà Con yêu VBA · 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.

Gà Con yêu VBA · 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.

Gà Con yêu VBA · 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

Gà Con yêu VBA · 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 độ.

Gà Con yêu VBA · 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!

Gà Con yêu VBA · 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

Gà Con yêu VBA · 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?

Gà Con yêu VBA · 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

Gà Con yêu VBA · 16/11/24

SA_DQ đã viết:
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)

Sub Tao20SoNgauBeHon81() : em hiểu nó làm nhiệm vụ tạo data để test code, data thì có sẵn rồi ạ, và em cũng đã code 1 chương trình tạo dữ liệu 20 số không trùng lặp trong 1 hàng và chạy 100 hàng. em dùng Dic để ko có trùng lặp, code bác em học thêm được câu lệnh randomize ạ.

Sub TimKiem() : cái này chưa đúng yêu cầu, yêu cầu tìm ra bộ 8 số mà bộ 8 số đó xuất hiện đồng thời ở nhiều hàng dữ liệu nhất ạ

Sub SapXep() : chắc phục vụ cho Sub tìm kiếm của bác

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

CHAOQUAY đã viết:
Cái này chứng minh loại trừ cũng dễ mà bạn

chứng mình thì ko hẵn, em cần cách tìm ra bộ số đó. nếu ko tiện chia sẻ ở đây bác cho em xin thông tin liên hệ ạ

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

cantl đã viết:
Bạn đúng là ông vua của kỹ thuật số. Khâm phục khâm phục.

Tác giả: đầu tiên tổng hợp ra 12 triệu bộ số như trên đã, loại bỏ trùng rồi cho lặp thôi. Nếu biết code thì chắc làm ngon.

em gà mờ về VBA thôi, đang nghiên cứu và tham khảo các bác ạ

HeSanbi · 16/11/24

Môn này là Vietlott hay Keno vậy bạn, nếu liên quan tới trò chơi ăn thua trúng thưởng, thì mình khuyên bạn nên sớm từ bỏ.
Nếu dùng trí tuệ và công sức học tập để vào những việc này thì hại nhiều mà lợi không thấy đâu.

Dùng não bộ để tính toán bạn sẽ mất đi hàng tỉ nơ-ron quý giá, mất rồi muốn có lại phải ăn thật nhiều đồ ăn bổ dưỡng, bộ não mà đến giai đoạn không còn khả năng tư duy nữa thì hối tiếc không kịp.
Nên để dành cho việc lành mạnh sẽ có ích và có lợi. Chấp nhận làm công có lương, tích lũy ít từ từ sẽ có nhiều.

Gà Con yêu VBA · 16/11/24

HeSanbi đã viết:
Môn này là Vietlott hay Keno vậy bạn, nếu liên quan tới trò chơi ăn thua trúng thưởng, thì mình khuyên bạn nên sớm từ bỏ.
Nếu dùng trí tuệ và công sức học tập để vào những việc này thì hại nhiều mà lợi không thấy đâu.

Dùng não bộ để tính toán bạn sẽ mất đi hàng tỉ nơ-ron quý giá, mất rồi muốn có lại phải ăn thật nhiều đồ ăn bổ dưỡng, bộ não mà đến giai đoạn không còn khả năng tư duy nữa thì hối tiếc không kịp.
Nên để dành cho việc lành mạnh sẽ có ích và có lợi. Chấp nhận làm công có lương, tích lũy ít từ từ sẽ có nhiều.

cảm ơn bác, em chỉ là rèn luyện code thôi ạ. có bác chỉ em học về tổ hợp và đệ quy, em đang nghiên cứu tiếp

SA_DQ · 17/11/24

Cái khác nhau giữa bạn & mình là ở chỗ: Bạn đi tìm 8 số cho trước; Còn mình là đi tìm 8 số mà các số này có nhiều nhất trong bảng số liệu của bạn;
Vì bạn để ngay dòng đầu tiên là kết quả & là kết quả duy nhất, nên mình cho vòng lặp tìm từ dưới lên & chỉ mất chưa đến .3 gy thôi:

22	23	24	25	26
8		Số	Lặp	0.25
8		20	33	47
		5	32	25
		6	32	62
		13	32	61
5		27	32	34
		40	32	70
		30	31	64
		62	31	30

Chú thích hình:
→ Các số trên hàng trên cùng là chỉ số cột (trên trang tính của bạn & dược nối thêm tới 26)
→ Các số từ 47 tới 30 của cột 26 này là những con số bạn tự chọn
→ (Các con số từ 20 đến 62 là số trong bảng của bạn có số lần lặp lại lớn nhất
& đây cũng là 8 con số mình lấy ra để đi tìm trong đống dữ liệu của bạn)
→ Con số 0.25 là thời gian tiêu tốn cho macro dưới đây để tìm ra theo iêu cầu của bạn

PHP:

Sub Tim8SoTuCacHang()
 Dim Rng As Range, sRng As Range, Cls As Range, tRg As Range
 Dim Tmr As Double, J As Integer, W8 As Integer, Max8 As Integer
 
 Set tRg = [Z3:Z10]:                    Tmr = Timer()
 For J = 102 To 3 Step -1
    Set Rng = Cells(J, "A").Resize(, 20)
    For Each Cls In tRg
        Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then
            W8 = W8 + 1
        End If
    Next Cls
    If W8 > Max8 Then
        Cells(J, "V").Value = W8:       Max8 = W8
    End If
    W8 = 0
 Next J
 [Z2].Value = Timer() - Tmr
End Sub

Thân & chúc vui nha!

bebo021999 · 17/11/24

Vì không rõ lắm kết quả của bạn muốn có là gì, nên mình cho liệt kê hết các bộ 8 số (trong mỗi bộ sort theo thứ tự A-Z)
cùng với số thứ tự dòng chứa bộ số đó (trong mỗi dòng thì 8 số đó xuất hiện ngẫu nhiên không theo thứ tự)
Từ bảng kết quả đó, bạn có thể sort, filter hay trích xuất theo điều kiện nào đó thì tùy bạn

Mã:

Option Explicit
Sub RandSetNumber()
Dim lr&, i&, j&, k&, m&, n&, tmp, res(1 To 10000, 1 To 2), t, st As String, st2 As String
Dim r&, c&, so As String, dong As String, rng
Dim dic As Object, dic2 As Object
Set dic = CreateObject("Scripting.dictionary"): Set dic2 = CreateObject("Scripting.dictionary")
t = Timer
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A3:T" & lr).Value

'sort tung dòng theo thu tu tang dan tu trai sang phai
For i = 1 To UBound(rng)
    For m = 1 To UBound(rng, 2) - 1
        For n = m + 1 To UBound(rng, 2)
            If rng(i, n) < rng(i, m) Then
                tmp = rng(i, n): rng(i, n) = rng(i, m): rng(i, m) = tmp
            End If
        Next
    Next
Next

'so sanh tung dong voi cac dong con lai, neu so o = nhau >=8 thi cong don vao c
'sau do luu ket qua vao array res
For i = 1 To UBound(rng)
    c = 0
    For j = 1 To UBound(rng)
        st = i & ", " & j: st2 = j & ", " & i
        If j <> i And Not dic2.exists(st2) Then
            r = 0: so = "": dong = i '
            For n = 1 To UBound(rng, 2)
                For m = 1 To UBound(rng, 2)
                    If rng(j, n) = rng(i, m) Then
                        so = IIf(so = "", "", so & ", ") & rng(j, n)
                        r = r + 1
                    End If
                Next
            Next
            If r >= 8 Then
                c = c + 1
                dic2.Add st, ""
                dong = IIf(dong = "", "", dong & ", ") & j
                k = k + 1: res(k, 1) = so: res(k, 2) = dong
            End If
        End If
    Next
Next
If k = 0 Then Exit Sub

'Loai trung BO SO, noi chuoi ket qua o
For i = 1 To k
    If Not dic.exists(res(i, 1)) Then
        dic.Add res(i, 1), res(i, 2)
    Else
        dic(res(i, 1)) = dic(res(i, 1)) & ", " & res(i, 2)
    End If
Next

'Dan ket qua vao sheet
With Range("V8")
    .Resize(10000, 2).ClearContents
    .Resize(dic.Count, 2).Value = WorksheetFunction.Transpose(Array(dic.keys, dic.items))
End With
MsgBox Timer - t
End Sub

truongvu317 · 17/11/24

Như này có vẻ thấy đúng, cách làm ở bài 26 thì được tầm 95%, phát triển thêm chắc sẽ mượt mà tầm vài giây.

cantl · 17/11/24

Cùng đáp án này thì tác giả phải liên hệ ông hoàng lô đề bán cháo quẩy rồi.

Gà Con yêu VBA · 17/11/24

SA_DQ đã viết:
Cái khác nhau giữa bạn & mình là ở chỗ: Bạn đi tìm 8 số cho trước;

Cúc Hr đã viết:

Chào anh/chị.

Em có file excel dữ liệu đính kèm. Trong file có sheet data là dữ liệu em đã chuẩn bị sẵn. Nhờ anh/chị hướng dẫn giúp em cách lọc được dữ liệu những cột ( từ cột I đến cột M) thể hiện giờ chấm công ở sheet Data để đưa sang sheet Kết quả.

Cám ơn anh/chị.

Nhấp chuột vào đây để mở rộng...

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

Nhấp chuột vào đây để mở rộng...

cantl đã viết:

Trên này có vẻ chỉ có tớ và cậu đam mê Đề án phát triển sông Lô. Xin được gọi 1 tiếng đồng chí.

Nhấp chuột vào đây để mở rộng...

SA_DQ đã viết:

Cái khác nhau giữa bạn & mình là ở chỗ: Bạn đi tìm 8 số cho trước; Còn mình là đi tìm 8 số mà các số này có nhiều nhất trong bảng số liệu của bạn;
Vì bạn để ngay dòng đầu tiên là kết quả & là kết quả duy nhất, nên mình cho vòng lặp tìm từ dưới lên & chỉ mất chưa đến .3 gy thôi:

22 23 24 25 26
8
Số Lặp
0.25
8
20
33
47
5
32
25
6
32
62
13
32
61
5
27
32
34
40
32
70
30
31
64
62
31
30

Chú thích hình:
→ Các số trên hàng trên cùng là chỉ số cột (trên trang tính của bạn & dược nối thêm tới 26)
→ Các số từ 47 tới 30 của cột 26 này là những con số bạn tự chọn
→ (Các con số từ 20 đến 62 là số trong bảng của bạn có số lần lặp lại lớn nhất
& đây cũng là 8 con số mình lấy ra để đi tìm trong đống dữ liệu của bạn)
→ Con số 0.25 là thời gian tiêu tốn cho macro dưới đây để tìm ra theo iêu cầu của bạn

PHP:

Sub Tim8SoTuCacHang() Dim Rng As Range, sRng As Range, Cls As Range, tRg As Range Dim Tmr As Double, J As Integer, W8 As Integer, Max8 As Integer Set tRg = [Z3:Z10]: Tmr = Timer() For J = 102 To 3 Step -1 Set Rng = Cells(J, "A").Resize(, 20) For Each Cls In tRg Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole) If Not sRng Is Nothing Then W8 = W8 + 1 End If Next Cls If W8 > Max8 Then Cells(J, "V").Value = W8: Max8 = W8 End If W8 = 0 Next J [Z2].Value = Timer() - Tmr End Sub

Thân & chúc vui nha!

Nhấp chuột vào đây để mở rộng...

SA_DQ đã viết:

Còn mình là đi tìm 8 số mà các số này có nhiều nhất trong bảng số liệu của bạn

Nhấp chuột vào đây để mở rộng...

Bác đang hiểu sai yêu cầu . Nó phải thoả mãn là cả bộ 8 số này cùng xuất hiện trong 1 hàng mới tính là 1 lần. và thêm yêu cầu số 2 là cả bộ đó xuất hiện đồng thời ở nhiều hàng nhất ạ.

SA_DQ đã viết:
;
Vì bạn để ngay dòng đầu tiên là kết quả & là kết quả duy nhất, nên mình cho vòng lặp tìm từ dưới lên & chỉ mất chưa đến .3 gy thôi:

22 23 24 25 26
8
Số Lặp
0.25
8
20
33
47
5
32
25
6
32
62
13
32
61
5
27
32
34
40
32
70
30
31
64
62
31
30

Chú thích hình:
→ Các số trên hàng trên cùng là chỉ số cột (trên trang tính của bạn & dược nối thêm tới 26)
→ Các số từ 47 tới 30 của cột 26 này là những con số bạn tự chọn
→ (Các con số từ 20 đến 62 là số trong bảng của bạn có số lần lặp lại lớn nhất
& đây cũng là 8 con số mình lấy ra để đi tìm trong đống dữ liệu của bạn)
→ Con số 0.25 là thời gian tiêu tốn cho macro dưới đây để tìm ra theo iêu cầu của bạn

PHP:

Sub Tim8SoTuCacHang() Dim Rng As Range, sRng As Range, Cls As Range, tRg As Range Dim Tmr As Double, J As Integer, W8 As Integer, Max8 As Integer Set tRg = [Z3:Z10]: Tmr = Timer() For J = 102 To 3 Step -1 Set Rng = Cells(J, "A").Resize(, 20) For Each Cls In tRg Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole) If Not sRng Is Nothing Then W8 = W8 + 1 End If Next Cls If W8 > Max8 Then Cells(J, "V").Value = W8: Max8 = W8 End If W8 = 0 Next J [Z2].Value = Timer() - Tmr End Sub

Thân & chúc vui nha!

" Vì bạn để ngay dòng đầu tiên là kết quả & là kết quả duy nhất, nên mình cho vòng lặp tìm từ dưới lên & chỉ mất chưa đến .3 gy thôi: "
===> em chưa có tìm được kết quả đáp án, như bài viết chú thích đó không phải là kết quả mà chỉ là ví dụ cho các bác hiểu bộ 8 số xuất hiện đồng thời là như nào ạ

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

bebo021999 đã viết:

Vì không rõ lắm kết quả của bạn muốn có là gì, nên mình cho liệt kê hết các bộ 8 số (trong mỗi bộ sort theo thứ tự A-Z)
cùng với số thứ tự dòng chứa bộ số đó (trong mỗi dòng thì 8 số đó xuất hiện ngẫu nhiên không theo thứ tự)
Từ bảng kết quả đó, bạn có thể sort, filter hay trích xuất theo điều kiện nào đó thì tùy bạn

Mã:

Option Explicit
Sub RandSetNumber()
Dim lr&, i&, j&, k&, m&, n&, tmp, res(1 To 10000, 1 To 2), t, st As String, st2 As String
Dim r&, c&, so As String, dong As String, rng
Dim dic As Object, dic2 As Object
Set dic = CreateObject("Scripting.dictionary"): Set dic2 = CreateObject("Scripting.dictionary")
t = Timer
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A3:T" & lr).Value

'sort tung dòng theo thu tu tang dan tu trai sang phai
For i = 1 To UBound(rng)
    For m = 1 To UBound(rng, 2) - 1
        For n = m + 1 To UBound(rng, 2)
            If rng(i, n) < rng(i, m) Then
                tmp = rng(i, n): rng(i, n) = rng(i, m): rng(i, m) = tmp
            End If
        Next
    Next
Next

'so sanh tung dong voi cac dong con lai, neu so o = nhau >=8 thi cong don vao c
'sau do luu ket qua vao array res
For i = 1 To UBound(rng)
    c = 0
    For j = 1 To UBound(rng)
        st = i & ", " & j: st2 = j & ", " & i
        If j <> i And Not dic2.exists(st2) Then
            r = 0: so = "": dong = i '
            For n = 1 To UBound(rng, 2)
                For m = 1 To UBound(rng, 2)
                    If rng(j, n) = rng(i, m) Then
                        so = IIf(so = "", "", so & ", ") & rng(j, n)
                        r = r + 1
                    End If
                Next
            Next
            If r >= 8 Then
                c = c + 1
                dic2.Add st, ""
                dong = IIf(dong = "", "", dong & ", ") & j
                k = k + 1: res(k, 1) = so: res(k, 2) = dong
            End If
        End If
    Next
Next
If k = 0 Then Exit Sub

'Loai trung BO SO, noi chuoi ket qua o
For i = 1 To k
    If Not dic.exists(res(i, 1)) Then
        dic.Add res(i, 1), res(i, 2)
    Else
        dic(res(i, 1)) = dic(res(i, 1)) & ", " & res(i, 2)
    End If
Next

'Dan ket qua vao sheet
With Range("V8")
    .Resize(10000, 2).ClearContents
    .Resize(dic.Count, 2).Value = WorksheetFunction.Transpose(Array(dic.keys, dic.items))
End With
MsgBox Timer - t
End Sub

Em cũng đang đi theo hướng liệt kê tất cả các bộ 8 số từ bảng dữ liệu ra để xét
nhưng em thấy có vẻ bác làm chưa ổn, đây là tổ hợp bộ 8 số từ 1 hàng 20 số = 125970 . nhân với 100 hàng thì kết quả phải là 1 259 700 kết quả chứ bác

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

truongvu317 đã viết:
Như này có vẻ thấy đúng, cách làm ở bài 26 thì được tầm 95%, phát triển thêm chắc sẽ mượt mà tầm vài giây.
View attachment 305652

chưa hiểu ý bạn lắm

bebo021999 · 18/11/24

Tuấn Bụng Bự đã viết:
Em cũng đang đi theo hướng liệt kê tất cả các bộ 8 số từ bảng dữ liệu ra để xét
nhưng em thấy có vẻ bác làm chưa ổn, đây là tổ hợp bộ 8 số từ 1 hàng 20 số = 125970 . nhân với 100 hàng thì kết quả phải là 1 259 700 kết quả chứ bác

Liệt kê ra hơn 1 triệu kết quả thì biết lưu ở đâu?
Mà liệt kê ra làm gì.
Kết quả mình làm là căn cứ 100 dòng có sẵn, liệt kê ra các bộ 8 số mà xuất hiện từ 2 dòng trở lên.

huuthang_bd · 18/11/24

Code bài #6 sửa lại sử dụng nhiều dic là ngon lành ngay.

Rich (BB code):

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")
  Dim aTmp(1 To 8)
  Dim ArrDic(1 To 73, 2 To 74) As Object
  For i = 1 To 73
    For j = 2 To 74
      Set ArrDic(i, j) = CreateObject("scripting.dictionary")
    Next
  Next
 
  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
      For j = 1 To k
        aTmp(j) = arr(i, a(r, j))
      Next j
      t = Join(aTmp, ",")
      n = ArrDic(aTmp(1), aTmp(2))(t) + 1
      ArrDic(aTmp(1), aTmp(2))(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

Gà Con yêu VBA · 19/11/24

bebo021999 đã viết:
Liệt kê ra hơn 1 triệu kết quả thì biết lưu ở đâu?
Mà liệt kê ra làm gì.
Kết quả mình làm là căn cứ 100 dòng có sẵn, liệt kê ra các bộ 8 số mà xuất hiện từ 2 dòng trở lên.

Thanks bác đã quan tâm.
Em xem kết quả file bác thì bác liệt kê các bộ số lúc thì 8, lúc thì 9, lúc thì 10 số .

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

huuthang_bd đã viết:

Code bài #6 sửa lại sử dụng nhiều dic là ngon lành ngay.

Rich (BB code):

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")
  Dim aTmp(1 To 8)
  Dim ArrDic(1 To 73, 2 To 74) As Object
  For i = 1 To 73
    For j = 2 To 74
      Set ArrDic(i, j) = CreateObject("scripting.dictionary")
    Next
  Next
 
  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
      For j = 1 To k
        aTmp(j) = arr(i, a(r, j))
      Next j
      t = Join(aTmp, ",")
      n = ArrDic(aTmp(1), aTmp(2))(t) + 1
      ArrDic(aTmp(1), aTmp(2))(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 để em nghiên cứu code này học hỏi ạ

VetMini · 20/11/24

Tuấn Bụng Bự đã viết:
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 ạ

Code của bạn ấy (bài #6) có hàm đệ quy. Một trong những khuyết điểm của đệ quy là số lượng gọi đệ quy. Nếu số lượng này cao là tràn bộ nhớ dễ dàng.

Bạ cần làm cái gì thật quan trọng thì hãy đeo đuổi tiếp. Nếu không thì đề bài tôi nói thẳng là không phù hợp với dân chỉ code hạng trung trung.
1. VBA là code lập trình ứng dụng. Bài này đòi hỏi lập trình Toán.
Nên giải nó bằng các ngôn ngữ chuyên thống kê, hoặc có thể import các phần mềm thóng kê viết từ dân ngoại hạng, như Python, R,...
2. Bạn có thể bảo rằng "dùng để học lập trình". Nhưng học kiểu này là lạc đường rồi.
Bài này phải chia ra thành từng phần nhỏ và tìm giải pháp tối ưu cho các phần ấy.
Các pháp ấy có thể ứng dụng nhiều kỹ thuật chuyên Toán mà phải trên cấp đại học mới học tới.

Gà Con yêu VBA · 22/11/24

VetMini đã viết:
Code của bạn ấy (bài #6) có hàm đệ quy. Một trong những khuyết điểm của đệ quy là số lượng gọi đệ quy. Nếu số lượng này cao là tràn bộ nhớ dễ dàng.

Bạ cần làm cái gì thật quan trọng thì hãy đeo đuổi tiếp. Nếu không thì đề bài tôi nói thẳng là không phù hợp với dân chỉ code hạng trung trung.
1. VBA là code lập trình ứng dụng. Bài này đòi hỏi lập trình Toán.
Nên giải nó bằng các ngôn ngữ chuyên thống kê, hoặc có thể import các phần mềm thóng kê viết từ dân ngoại hạng, như Python, R,...
2. Bạn có thể bảo rằng "dùng để học lập trình". Nhưng học kiểu này là lạc đường rồi.
Bài này phải chia ra thành từng phần nhỏ và tìm giải pháp tối ưu cho các phần ấy.
Các pháp ấy có thể ứng dụng nhiều kỹ thuật chuyên Toán mà phải trên cấp đại học mới học tới.

Vâng em đang đi theo hướng "Đệ Quy" code thì có rồi , hàm đệ quy có mấy dòng thôi mà em đang loạn não chưa hiểu được cái đoạn nó tự gọi lại chính nó

Em dân ko chuyên, công việc làm phải dùng đến VBA nên học bác ạ.
còn bài toán này là vô tình thấy trên nhóm fb nên tìm hiểu chơi ạ


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) (1 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ó

Gà VBA - 0856 120 789

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Gà VBA - 0856 120 789

/(hông là gì!

Thành viên gạo cội

File đính kèm

Thành viên tích cực

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

Gà VBA - 0856 120 789

Thành viên gạo cội

Chuyên gia GPE

Gà VBA - 0856 120 789

Đang đi tìm hòn đá

Gà VBA - 0856 120 789

Thời gian đếm ngược.