TỔ HỢP CHẬP 6 CỦA 45
-
thì mỗi ngày Tớ sẽ cố gắng nhập các giá trị ấy, khi nào nó báo được thì dừng. Có gì giúp mình với vì trong ví có hơn 500$, lấy được thì tốt.Cảm ơn bạn trước
thì mỗi ngày Tớ sẽ cố gắng nhập các giá trị ấy, khi nào nó báo được thì dừng. Có gì giúp mình với vì trong ví có hơn 500$, lấy được thì tốt.
Bạn đang xem: Tổ hợp chập 6 của 45
Cái ví đó có giới hạn số lần nhập sai liên tiếp không bạn?Nếu không giới hạn thì mình có thể viết một ứng dụng nhỏ để nó tự động điền.
Reactions:Phan Thế Hiệp, HieuCD và Phuocam
NhattanktnnThành viên gắn bó
Giới tínhNam
Con nít cũng biết người ta làm bộ để dụ.Chứ làm gì có chuyện "mỗi ngày sẽ cố gắng nhập". Người siêng mức độ này không thể nào không biết làm toán.
Xem thêm: Tả Hình Ảnh Mẹ Nấu Cơm - Tả Mẹ Đang Nấu Cơm (18 Mẫu)
thì mỗi ngày Tớ sẽ cố gắng nhập các giá trị ấy, khi nào nó báo được thì dừng. Có gì giúp mình với vì trong ví có hơn 500$, lấy được thì tốt.Cảm ơn bạn trước
Con nít cũng biết người ta làm bộ để dụ.Chứ làm gì có chuyện "mỗi ngày sẽ cố gắng nhập". Người siêng mức độ này không thể nào không biết làm toán.
Mình cũng biết như vậy, tuy nhiên mình sẽ loại trừ, lấy data thỏa mãn kí hiệu đầu tiên và thứ 2 là đúng thì sẽ giảm đi được 10 phần rồi bạn. Nếu được bạn giúp mình nhé
Option Explicit Dim a, S, sTran&, sVong&, sD& Dim n&, i&, r&, k&, j&, j2&, c&, t&, z&, iKey$, iKey2$ Sub XYZ() Dim sArr(), res(), dic As Object, sDoi& Randomize Set dic = CreateObject("scripting.dictionary") With Sheets("Ten") sArr = .Range("B4", .Range("B" & Rows.Count).End(xlUp)).Value End With sDoi = UBound(sArr) Call XepLich(res, sArr, dic, sDoi) n = UBound(res) For j = 1 To sVong "Gan ten cac doi For i = 1 To sTran S = Split(res(i, j), "_") res(i, j) = sArr(CLng(S(0)), 1) & "_" & sArr(CLng(S(1)), 1) Next i If n > sTran Then res(n, j) = sArr(res(n, j), 1) Next j Sheets("Sheet1").Range("B4:X100").ClearContents Sheets("Sheet1").Range("B4").Resize(n, sVong) = resEnd SubPrivate Sub XepLich(res, sArr, dic, sDoi) Dim bDoiLe As Boolean bDoiLe = ((sDoi Mod 2) = 1) If bDoiLe Then sVong = sDoi Else sVong = sDoi - 1 "So vong dau sTran = sDoi \ 2 "So Tran 1 vong sD = sTran * 2 "so Doi 1 vongTuDau: If bDoiLe = True Then ReDim res(1 To sTran + 1, 1 To sVong) a = UniqueRand(sVong) For n = 1 To sVong res(sTran + 1, n) = a(n) Next n Else ReDim res(1 To sTran, 1 To sVong) End If For n = 1 To sVongTroLai: If bDoiLe = True Then a = CreateUniqueRand(sDoi, res(sTran + 1, n)) Else a = UniqueRand(sD) End If k = 0: i = 0 Do While k Empty Then k = k + 1 res(k, n) = a(i) a(i) = Empty For j = i + 1 To sD "*** If a(j) Empty Then iKey = KeyValue(res(k, n), a(j)) If dic.exists(iKey) = False Then dic.Add iKey, "" res(k, n) = iKey a(j) = Empty Exit For End If End If Next j If j = sD + 1 Then "*** For r = 1 To k - 1 S = Split(res(r, n), "_") For c = 0 To 1 iKey = KeyValue(res(k, n), S(c)) If dic.exists(iKey) = False Then If c = 0 Then t = S(1) Else t = S(0) For j2 = i + 1 To sD "*** If a(j2) Empty Then iKey2 = KeyValue(t, a(j2)) If dic.exists(iKey2) = False Then dic.Remove (res(r, n)) res(r, n) = iKey2: res(k, n) = iKey dic.Add iKey, "": dic.Add iKey2, "" a(j2) = Empty GoTo Thoat End If End If Next j2 End If Next c Next r If r = k Then "**** z = z + 1 If z = 50 Then dic.RemoveAll: z = 0: GoTo TuDau Call RemoveDic(res, dic) GoTo TroLai End If End If End IfThoat: Loop Next nEnd SubPrivate Sub RemoveDic(ByRef res, ByRef dic) For r = 1 To k - 1 dic.Remove (res(r, n)) Next rEnd SubPrivate Function KeyValue(ByVal val_1, ByVal val_2) As String If CLng(val_1) notNum Then k = k + 1 res(k) = arr(i) End If Next i CreateUniqueRand = resEnd FunctionPrivate Function UniqueRand(ByVal n As Long) As Variant Dim arr() As Long, i&, RndNum&, tmp& ReDim arr(1 To n) "Randomize For i = 1 To n RndNum = Int(n * Rnd() + 1) If arr(RndNum) = 0 Then tmp = RndNum Else tmp = arr(RndNum) If arr(n) = 0 Then arr(RndNum) = n Else arr(RndNum) = arr(n) arr(n) = tmp n = n - 1 Next i UniqueRand = arrEnd Function
Nhấp chuột vào đây để mở rộng...
Xem thêm: Bài $5$ Một Số Khi Nhân Với 6 Rồi Cộng Với 157 Thì Được 769 Tìm Số Đó
Dùng thuật toán mới code gọn và nhanh hơn nhiều
Mã:Sao chép.
Option ExplicitSub LichThiDauVongTron() Dim sArr(), a&(), aNN, res$() Dim sDoi&, N&, sR&, i&, j&, k& With Sheets("Ten") sArr = .Range("B4", .Range("B" & Rows.Count).End(xlUp)).Value End With sDoi = UBound(sArr) If sDoi Mod 2 = 1 Then N = sDoi Else N = sDoi - 1 ReDim a(1 To N, 1 To N) For j = 1 To N k = j - 1 For i = 1 To N If k = N Then k = 1 Else k = k + 1 a(i, j) = k Next i Next j sR = sDoi \ 2 ReDim res(1 To sR, 1 To N) Randomize For j = 1 To N aNN = UniqueRand(sR) For i = 1 To sR - sDoi + N res(aNN(i), j) = sArr(a(i, j), 1) & "_" & sArr(a(N - i, j), 1) Next i If sDoi > N Then res(aNN(sR), j) = sArr(a(N, j), 1) & "_" & sArr(sDoi, 1) Next j Sheets("Sheet1").Range("B3").CurrentRegion.Offset(1).ClearContents Sheets("Sheet1").Range("B4").Resize(sR, N) = resEnd SubPrivate Function UniqueRand(ByVal N As Long) As Variant Dim arr() As Long, i&, RndNum&, tmp& ReDim arr(1 To N) "Randomize For i = 1 To N RndNum = Int(N * Rnd() + 1) If arr(RndNum) = 0 Then tmp = RndNum Else tmp = arr(RndNum) If arr(N) = 0 Then arr(RndNum) = N Else arr(RndNum) = arr(N) arr(N) = tmp N = N - 1 Next i UniqueRand = arrEnd Function
thì mỗi ngày Tớ sẽ cố gắng nhập các giá trị ấy, khi nào nó báo được thì dừng. Có gì giúp mình với vì trong ví có hơn 500$, lấy được thì tốt.
Bạn đang xem: Tổ hợp chập 6 của 45
Cái ví đó có giới hạn số lần nhập sai liên tiếp không bạn?Nếu không giới hạn thì mình có thể viết một ứng dụng nhỏ để nó tự động điền.
Reactions:Phan Thế Hiệp, HieuCD và Phuocam
NhattanktnnThành viên gắn bó
Con nít cũng biết người ta làm bộ để dụ.Chứ làm gì có chuyện "mỗi ngày sẽ cố gắng nhập". Người siêng mức độ này không thể nào không biết làm toán.
Xem thêm: Tả Hình Ảnh Mẹ Nấu Cơm - Tả Mẹ Đang Nấu Cơm (18 Mẫu)
thì mỗi ngày Tớ sẽ cố gắng nhập các giá trị ấy, khi nào nó báo được thì dừng. Có gì giúp mình với vì trong ví có hơn 500$, lấy được thì tốt.Cảm ơn bạn trước
Con nít cũng biết người ta làm bộ để dụ.Chứ làm gì có chuyện "mỗi ngày sẽ cố gắng nhập". Người siêng mức độ này không thể nào không biết làm toán.
Mình cũng biết như vậy, tuy nhiên mình sẽ loại trừ, lấy data thỏa mãn kí hiệu đầu tiên và thứ 2 là đúng thì sẽ giảm đi được 10 phần rồi bạn. Nếu được bạn giúp mình nhé
Option Explicit Dim a, S, sTran&, sVong&, sD& Dim n&, i&, r&, k&, j&, j2&, c&, t&, z&, iKey$, iKey2$ Sub XYZ() Dim sArr(), res(), dic As Object, sDoi& Randomize Set dic = CreateObject("scripting.dictionary") With Sheets("Ten") sArr = .Range("B4", .Range("B" & Rows.Count).End(xlUp)).Value End With sDoi = UBound(sArr) Call XepLich(res, sArr, dic, sDoi) n = UBound(res) For j = 1 To sVong "Gan ten cac doi For i = 1 To sTran S = Split(res(i, j), "_") res(i, j) = sArr(CLng(S(0)), 1) & "_" & sArr(CLng(S(1)), 1) Next i If n > sTran Then res(n, j) = sArr(res(n, j), 1) Next j Sheets("Sheet1").Range("B4:X100").ClearContents Sheets("Sheet1").Range("B4").Resize(n, sVong) = resEnd SubPrivate Sub XepLich(res, sArr, dic, sDoi) Dim bDoiLe As Boolean bDoiLe = ((sDoi Mod 2) = 1) If bDoiLe Then sVong = sDoi Else sVong = sDoi - 1 "So vong dau sTran = sDoi \ 2 "So Tran 1 vong sD = sTran * 2 "so Doi 1 vongTuDau: If bDoiLe = True Then ReDim res(1 To sTran + 1, 1 To sVong) a = UniqueRand(sVong) For n = 1 To sVong res(sTran + 1, n) = a(n) Next n Else ReDim res(1 To sTran, 1 To sVong) End If For n = 1 To sVongTroLai: If bDoiLe = True Then a = CreateUniqueRand(sDoi, res(sTran + 1, n)) Else a = UniqueRand(sD) End If k = 0: i = 0 Do While k Empty Then k = k + 1 res(k, n) = a(i) a(i) = Empty For j = i + 1 To sD "*** If a(j) Empty Then iKey = KeyValue(res(k, n), a(j)) If dic.exists(iKey) = False Then dic.Add iKey, "" res(k, n) = iKey a(j) = Empty Exit For End If End If Next j If j = sD + 1 Then "*** For r = 1 To k - 1 S = Split(res(r, n), "_") For c = 0 To 1 iKey = KeyValue(res(k, n), S(c)) If dic.exists(iKey) = False Then If c = 0 Then t = S(1) Else t = S(0) For j2 = i + 1 To sD "*** If a(j2) Empty Then iKey2 = KeyValue(t, a(j2)) If dic.exists(iKey2) = False Then dic.Remove (res(r, n)) res(r, n) = iKey2: res(k, n) = iKey dic.Add iKey, "": dic.Add iKey2, "" a(j2) = Empty GoTo Thoat End If End If Next j2 End If Next c Next r If r = k Then "**** z = z + 1 If z = 50 Then dic.RemoveAll: z = 0: GoTo TuDau Call RemoveDic(res, dic) GoTo TroLai End If End If End IfThoat: Loop Next nEnd SubPrivate Sub RemoveDic(ByRef res, ByRef dic) For r = 1 To k - 1 dic.Remove (res(r, n)) Next rEnd SubPrivate Function KeyValue(ByVal val_1, ByVal val_2) As String If CLng(val_1) notNum Then k = k + 1 res(k) = arr(i) End If Next i CreateUniqueRand = resEnd FunctionPrivate Function UniqueRand(ByVal n As Long) As Variant Dim arr() As Long, i&, RndNum&, tmp& ReDim arr(1 To n) "Randomize For i = 1 To n RndNum = Int(n * Rnd() + 1) If arr(RndNum) = 0 Then tmp = RndNum Else tmp = arr(RndNum) If arr(n) = 0 Then arr(RndNum) = n Else arr(RndNum) = arr(n) arr(n) = tmp n = n - 1 Next i UniqueRand = arrEnd Function
Nhấp chuột vào đây để mở rộng...
Xem thêm: Bài $5$ Một Số Khi Nhân Với 6 Rồi Cộng Với 157 Thì Được 769 Tìm Số Đó
Dùng thuật toán mới code gọn và nhanh hơn nhiều
Mã:Sao chép.
Option ExplicitSub LichThiDauVongTron() Dim sArr(), a&(), aNN, res$() Dim sDoi&, N&, sR&, i&, j&, k& With Sheets("Ten") sArr = .Range("B4", .Range("B" & Rows.Count).End(xlUp)).Value End With sDoi = UBound(sArr) If sDoi Mod 2 = 1 Then N = sDoi Else N = sDoi - 1 ReDim a(1 To N, 1 To N) For j = 1 To N k = j - 1 For i = 1 To N If k = N Then k = 1 Else k = k + 1 a(i, j) = k Next i Next j sR = sDoi \ 2 ReDim res(1 To sR, 1 To N) Randomize For j = 1 To N aNN = UniqueRand(sR) For i = 1 To sR - sDoi + N res(aNN(i), j) = sArr(a(i, j), 1) & "_" & sArr(a(N - i, j), 1) Next i If sDoi > N Then res(aNN(sR), j) = sArr(a(N, j), 1) & "_" & sArr(sDoi, 1) Next j Sheets("Sheet1").Range("B3").CurrentRegion.Offset(1).ClearContents Sheets("Sheet1").Range("B4").Resize(sR, N) = resEnd SubPrivate Function UniqueRand(ByVal N As Long) As Variant Dim arr() As Long, i&, RndNum&, tmp& ReDim arr(1 To N) "Randomize For i = 1 To N RndNum = Int(N * Rnd() + 1) If arr(RndNum) = 0 Then tmp = RndNum Else tmp = arr(RndNum) If arr(N) = 0 Then arr(RndNum) = N Else arr(RndNum) = arr(N) arr(N) = tmp N = N - 1 Next i UniqueRand = arrEnd Function
