Lưu các giá trị từ 1-9, với tổng của các giá trị bằng tổng cho trước

[bebo021999]

Mình đang tập viết code cho yêu cầu sau:
Cho dãy số từ 1 tới 9
Trích xuất danh sách các số có 6 ký số (có thể trùng lặp), mà tổng các số bằng tổng cho trước.
Ví dụ: Với tổng =24
526254
344436
---
Sau đó mình dùng random để lấy 1 set bất kỳ.
Mình dự định như sau:
Chạy 6 vòng lặp For duyệt biến từ 1 tới 9
Tại vòng for thứ 6:
Nếu sum các giá trị =24 thì dùng Collection.Add để lưu trữ.
Kết thúc tất cả các vòng lặp
Dùng hàm RAND để trích xuất item ngẫu nhiên từ Collection.

Chạy thử thì ra kết quả, mà code chạy lâu quá. Khoảng 30s. Có thể do số lần tính toán của vòng lặp là 9^6 lần.

Nếu không dùng vòng lặp không thì có cách nào khác không?
Nếu dùng vòng lặp thì làm sao để cải thiện tốc độ?

Xin cảm ơn

 

[Ngô Hải Đăng]

Đề bài V.3: Liệt kê các số có 6 chữ số có tổng = 27 ('9' nút):

Cách giải rùa bò như sauL

Sub DuyetHetCacSoCo6KySo()
 Dim J As Long, Tmr As Double
 Dim Tong As Integer, W As Long, VTr As Integer
 ReDim Arr(1 To 60000, 1 To 1) As Long
 
 Tmr = Timer():             [D2].CurrentRegion.ClearContents
 For J = 100000 To 999999
    For VTr = 1 To 6
        Tong = Tong + Num(J, VTr)
    Next VTr
 
    If Tong = 27 Then
        W = W + 1:          Arr(W, 1) = J
        J = J + 8       '**  '
    End If
    Tong = 0
 Next J
 [D1].Value = Timer() - Tmr
 [D2].Resize(W).Value = Arr()
End Sub

Function Num(So As Long, VTr As Integer) As Integer
 Dim sTrC As String
 
 sTrC = CStr(So)
 Num = CInt(Mid(sTrC, VTr, 1))
End Function

& đây là vài kết quả từ chúng:

			. . . .	(Dòng)
			996111​	50399​
			996120​	50400​
			996201​	50401​
			996210​	50402​
			996300​	50403​
			997002​	50404​
			997011​	50405​
			997020​	50406​
			997101​	50407​
			997110​	50408​
			997200​	50409​
			998001​	50410​
			998010​	50411​
			998100​	50412​
			999000​	50413​

có thể cải tiến thêm cách của bác bằng cách tìm số nhỏ nhất thỏa điều kiện, sau đó cứ + thêm 9 cho đến khi nào lấy đủ kết quả.

 

[bebo021999]

Cám ơn tất cả các bạn!

 

[huuthang_bd]

Dạng bài này có cách hiệu quả hơn nữa: Xác định số nhỏ nhất thỏa điều kiện sau đó tính ra số thỏa điều kiện tiếp theo số vừa tìm được, cứ thế cho đến hết.

 

[bebo021999]

Dạng bài này có cách hiệu quả hơn nữa: Xác định số nhỏ nhất thỏa điều kiện sau đó tính ra số thỏa điều kiện tiếp theo số vừa tìm được, cứ thế cho đến hết.

Từ 111399 tới 993111? Nếu 24 không cố định mà thay đổi thì bài toán tổng quát sẽ phức tạp hơn.

 

[huuthang_bd]

Từ 111399 tới 993111? Nếu 24 không cố định mà thay đổi thì bài toán tổng quát sẽ phức tạp hơn.

Code theo hướng bài #23

#Const IncludeDigit0 = True
Function GetNumbers(lTotal As Long, lLength As Long, Optional ByRef n As Long) As Variant
Dim aResult(1 To &H100000, 1 To 1) As Variant, sNum As String, k As Long
If lLength <= 0 Or lTotal <= 0 Then
    GetNumbers = CVErr(2001)
    Exit Function
End If
k = (lTotal - 1) \ 9
Select Case lLength - k
Case Is < 0
    GetNumbers = CVErr(2001)
    Exit Function
Case Is < 2
    sNum = (lTotal - k * 9) & String(k, "9")
Case Else
    sNum = 1 & String(lLength - k - 2, "0") & (lTotal - k * 9 - 1) & String(k, "9")
End Select
k = 0
Do
    #If Not IncludeDigit0 Then
        If InStr(sNum, 0) = 0 Then
    #End If
        k = k + 1
        aResult(k, 1) = sNum
    #If Not IncludeDigit0 Then
        End If
    #End If
Loop While NextNumber(sNum, lLength)
GetNumbers = aResult
n = k
End Function
Private Function NextNumber(ByRef sNum As String, ByRef lLength As Long) As Boolean
Dim sTmpStr As String, lDigit0 As Long, lDigit9 As Long
If CLng(Mid(sNum, lLength, 1)) = 0 Then
    For i = lLength To 1 Step -1
        If Mid(sNum, i, 1) <> 0 Then Exit For
        lDigit0 = lDigit0 + 1
    Next
    For i = lLength - lDigit0 - 1 To 1 Step -1
        If Mid(sNum, i, 1) <> 9 Then Exit For
        lDigit9 = lDigit9 + 1
    Next
    If i = 0 Then GoTo ExitFunction
    sTmpStr = (Mid(sNum, lLength - lDigit0 - lDigit9 - 1, 1) + 1) & String(lDigit0, "0") & (Mid(sNum, lLength - lDigit0, 1) - 1) & String(lDigit9, "9")
    Mid(sNum, lLength - Len(sTmpStr) + 1) = sTmpStr
ElseIf CLng(Mid(sNum, lLength - 1, 1)) = 9 Then
    For i = lLength - 1 To 1 Step -1
        If Mid(sNum, i, 1) <> 9 Then Exit For
        lDigit9 = lDigit9 + 1
    Next
    If i = 0 Then GoTo ExitFunction
    sTmpStr = (Mid(sNum, lLength - lDigit9 - 1, 1) + 1) & (Mid(sNum, lLength, 1) - 1) & String(lDigit9, "9")
    Mid(sNum, lLength - Len(sTmpStr) + 1) = sTmpStr
Else
    Mid(sNum, lLength, 1) = Mid(sNum, lLength, 1) - 1
    Mid(sNum, lLength - 1, 1) = Mid(sNum, lLength - 1, 1) + 1
End If
NextNumber = True
ExitFunction:
End Function
''
Sub Test()
    Dim aArr As Variant, dT As Double, n As Long
    Range("A:A").ClearContents
    dT = Timer
    aArr = GetNumbers(22, 8, n)
    MsgBox Timer - dT
'    Application.ScreenUpdating = False
'    Range("A1:A" & n).Value = aArr
'    Application.ScreenUpdating = True
End Sub

 

[SA_DQ]

Nếu đề bãi là tìm các số có 6 chữ số có nghĩa, mà các ký số hoàn toàn không trùng nhau & có tổng là 1 số cho trước từ 15 cho đến 44, ta có bảng số liệu thú vị như sau:

	0.586	Tổng của 6 ký số	chia cho 120
	600	15	5
	600	16	5				0​
	1200	17	10
	1800	18	15
	3000	19	25
	3600	20	30
	5520	21	46
	6120	22	51
	8040	23	67
	8760	24	73
	10080	25	84
	10200	26	85
	11640	27	97
	10440	28	87
	10560	29	88
	9360	30	78
	8760	31	73
	6840	32	57
	6240	33	52
	4200	34	35
	3480	35	29
	2160	36	18
	1440	37	12
	720	38	6
	720	39	6
	0	40	0