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

Liên hệ QC
B

bebo021999

Thành viên gạo cội
Tham gia
26/1/11
Bài viết
5,939
Được thích
8,723
Giới tính
Nam
Nghề nghiệp
GPE
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
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Góp vui:
PHP: 
Public Function Random6(ByVal Tong As Integer)
Dim R1&, R2&, R3&, R4&, R5&, R6&
Randomize
Do
R1 = Int(Rnd() * 9) + 1
R2 = Int(Rnd() * 9) + 1
R3 = Int(Rnd() * 9) + 1
R4 = Int(Rnd() * 9) + 1
R5 = Int(Rnd() * 9) + 1
R6 = Tong - R1 - R2 - R3 - R4 - R5
Loop While R6 > 9 Or R6 < 1
Random6 = R1 & R2 & R3 & R4 & R5 & R6
End Function
 
Upvote 0
Thanks Phuocam
Dùng UDF kết xuất ra kết quả thì nhanh vì nó sẽ xuất ra kết quả đầu tiên tìm thấy.
Thay vì dùng UDF, mình có thể tạo danh sách duy nhất (dùng Dic? Collection?) và ghi ra sheet được không?
Mình dùng Collection nhưng vướng là phải chạy 6 cái vòng lặp 1-9

Thêm nữa là nếu tạo ID, dùng code tại #3 sẽ có khả năng trùng.
 
Upvote 0
bebo021999 đã viết:
Thanks Phuocam
Dùng UDF kết xuất ra kết quả thì nhanh vì nó sẽ xuất ra kết quả đầu tiên tìm thấy.
Thay vì dùng UDF, mình có thể tạo danh sách duy nhất (dùng Dic? Collection?) và ghi ra sheet được không?
Mình dùng Collection nhưng vướng là phải chạy 6 cái vòng lặp 1-9

Thêm nữa là nếu tạo ID, dùng code tại #3 sẽ có khả năng trùng.
Nhấp chuột vào đây để mở rộng...
Đưa code bạn lên, có thể cải thiện tốc độ.

.
 
Upvote 0
Phuocam đã viết:
Đưa code bạn lên, có thể cải thiện tốc độ.

.
Nhấp chuột vào đây để mở rộng...
Mình viết xong bỏ rồi. Đại khái thế này
PHP: 
Dim coL1 as Object
Set coL1= New Collection
 For c1=1 to 9
  For c2 = 1 to 9
...
   For c6 =1 to 9
   Sum=c1+c2+c3+c4+c5+c6
   If Sum =24 then
   coL1.Add c1&c2&c3&c4&c5&c6
   End if

.....
 
Upvote 0
bebo021999 đã viết:
Vậy mới hỏi có cách nào nhanh hơn chứ.
Nếu trích số 9 ký tự thành 9^9 chắc cháy máy luôn.
Nhấp chuột vào đây để mở rộng...
Thử code này:

PHP: 
Public Sub Random6()
Const Tong As Integer = 24
Dim arrResult As Variant
Dim R1&, R2&, R3&, R4&, R5&
Dim T2&, T3&, T4&, T5&, T6&, k&
Dim S2$, S3$, S4$, S5$
Dim t As Double
t = Timer
ReDim arrResult(1 To 1000000, 1 To 1)
For R1 = 1 To 9
    For R2 = 1 To 9
        T2 = R1 + R2
        S2 = R1 & R2
        For R3 = 1 To 9
            T3 = T2 + R3
            S3 = S2 & R3
            For R4 = 1 To 9
                T4 = T3 + R4
                S4 = S3 & R4
                If T4 >= Tong Then Exit For
                For R5 = 1 To 9
                    T5 = T4 + R5
                    S5 = S4 & R5
                    If T5 >= Tong Then
                        Exit For
                    Else
                        T6 = Tong - T5
                        If T6 > 0 Then
                            k = k + 1
                            arrResult(k, 1) = S5 & T6
                        End If
                    End If
                Next R5
            Next R4
        Next R3
    Next R2
If k = 1000000 Then Exit For
Next R1
If k > 0 Then Sheets("Sheet1").Range("A1").Resize(k, 1) = arrResult
MsgBox Timer - t
End Sub
 
Upvote 0
Xin phép chủ bài đăng cho mình đổi vài chỗ trong đề bài như sau:

Đề bài v.2: Lấy 6 ký số bất kỳ khác nhau trong dẫy 1, 2, 3, . . . .9, 0 để tạo thành con số nguyên gồm 6 kí số có nghĩa, ví dụ như 102345 hay 987654 có tổng các kí số trong chúng bằng với 1 số cho trước, ví dụ 27
Các bạn liệt kê giúp (tôi) danh sách thỏa điều kiện này
 
Upvote 0
Phuocam đã viết:
Thử code này:

PHP: 
Public Sub Random6()
Const Tong As Integer = 24
Dim arrResult As Variant
Dim R1&, R2&, R3&, R4&, R5&
Dim T2&, T3&, T4&, T5&, T6&, k&
Dim S2$, S3$, S4$, S5$
Dim t As Double
t = Timer
ReDim arrResult(1 To 1000000, 1 To 1)
For R1 = 1 To 9
    For R2 = 1 To 9
        T2 = R1 + R2
        S2 = R1 & R2
        For R3 = 1 To 9
            T3 = T2 + R3
            S3 = S2 & R3
            For R4 = 1 To 9
                T4 = T3 + R4
                S4 = S3 & R4
                If T4 >= Tong Then Exit For
                For R5 = 1 To 9
                    T5 = T4 + R5
                    S5 = S4 & R5
                    If T5 >= Tong Then
                        Exit For
                    Else
                        T6 = Tong - T5
                        If T6 > 0 Then
                            k = k + 1
                            arrResult(k, 1) = S5 & T6
                        End If
                    End If
                Next R5
            Next R4
        Next R3
    Next R2
If k = 1000000 Then Exit For
Next R1
If k > 0 Then Sheets("Sheet1").Range("A1").Resize(k, 1) = arrResult
MsgBox Timer - t
End Sub
Nhấp chuột vào đây để mở rộng...
Có nhiều kết quả có 7 số :p
bebo021999 đã viết:
Vậy mới hỏi có cách nào nhanh hơn chứ.
Nếu trích số 9 ký tự thành 9^9 chắc cháy máy luôn.
Nhấp chuột vào đây để mở rộng...
Thử code
Mã: 
Sub Tong_6Num()
  Dim res(1 To 1000000, 1 To 1) As Long
  Dim i&, i2&, i3&, i4&, i5&, N&, N2&, N3&, N4&, N5&, k&
  Const Tong As Long = 24
  Dim t As Double
 
  t = Timer
  For i = 1 To 9
    N = Tong - i
    If N = 4 Then Exit For
    If N <= 45 Then
      For i2 = 1 To 9
        N2 = N - i2
        If N2 = 3 Then Exit For
        If N2 <= 36 Then
          For i3 = 1 To 9
            N3 = N2 - i3
            If N3 = 2 Then Exit For
            If N <= 27 Then
              For i4 = 1 To 9
                N4 = N3 - i4
                If N4 = 1 Then Exit For
                If N4 <= 18 Then
                  For i5 = 1 To 9
                    N5 = N4 - i5
                    If N5 = 0 Then Exit For
                    If N5 <= 9 Then
                        k = k + 1
                        res(k, 1) = i & i2 & i3 & i4 & i5 & N5
                        If k = 1000000 Then GoTo Thoat
                    End If
                  Next i5
                End If
              Next i4
            End If
          Next i3
        End If
      Next i2
    End If
  Next i
Thoat:
  If k Then Range("C1").Resize(k, 1) = res
  MsgBox Timer - t
End Sub
 
Upvote 0
Tự sản, tự tiêu:
PHP: 
Sub Tong6KiSo_27()
 Dim J1 As Integer, J2 As Integer, J3 As Integer, J4 As Integer, J5 As Integer, J6 As Integer, Tmr As Double, W As Long
 Dim Tong6   As Long, Tmp As Integer

 ReDim Arr(1 To 8001, 1 To 1) As Long:              [B2].CurrentRegion.ClearContents
 Tmr = Timer()
 For J1 = 1 To 9
    For J2 = 0 To 9
        If J2 <> J1 Then
            For J3 = 0 To 9
                If J3 <> J2 And J3 <> J1 Then
                    For J4 = 0 To 9
                        If J4 <> J1 And J4 <> J2 And J4 <> J3 Then
                            For J5 = 1 To 9
                                If J5 <> J1 And J5 <> J2 And J5 <> J3 And J5 <> J4 Then
                                    For J6 = 0 To 9
                                        If J6 <> J1 And J6 <> J2 And J6 <> J3 And J6 <> J4 And J6 <> J5 Then
                                            Tong6 = J1 + J2 + J3 + J4 + J5 + J6
                                            If Tong6 = 27 Then
                                                W = W + 1
                                                If W > 7000 Then
                                                    Tmp = Tmp + 1:                  On Error GoTo GPE
                            Arr(Tmp, 1) = J1 * 100000 + J2 * 10000 + J3 * 1000 + J4 * 100 + J5 * 10 + J6
                                                End If
                                            End If
                                        End If
                                    Next J6
                                End If
                            Next J5
                        End If
                    Next J4
                End If
            Next J3
        End If
    Next J2
 Next J1
GPE: [B1].Value = Timer() - Tmr:                    [B2].Resize(Tmp).Value = Arr()
End Sub
 
Upvote 0
Code tổng quát, có tùy chọn có hoặc không có số 0.
Mã: 
Const MinDigit As Long = 0
Function GetNumbers(ByVal lTotalOfDigits As Long, ByVal lLength As Long) As Variant
    Dim aCol() As String, k As Long
    ReDim Preserve aCol(1 To &H100000)
    If lLength > 0 Then
        FindNums "", lTotalOfDigits, lLength, aCol, k
    End If
    If k > 0 Then
        ReDim Preserve aCol(1 To k)
        GetNumbers = GetResult(aCol)
    End If
End Function
Private Sub FindNums(ByVal sStr As String, ByVal lRestTotal As Long, ByRef lLength As Long, ByRef aCol() As String, ByRef k As Long)
Dim i As Long, lMin As Long
lRestLength = lLength - Len(sStr)
lMin = CLng(Right(MinDigit & sStr, 1))
If lRestTotal < lRestLength * lMin Then Exit Sub
If lRestTotal > lRestLength * 9 Then Exit Sub
If lRestLength = 1 Then
    If lRestTotal >= lMin And lRestTotal <= 9 Then
        k = k + 1
        aCol(k) = sStr & lRestTotal
    End If
Else
    For i = lMin To 9
        FindNums sStr & i, lRestTotal - i, lLength, aCol, k
    Next
End If
End Sub
Private Function GetResult(ByRef aCol As Variant) As Variant
Dim aResult() As String, aFinalResult() As String, i As Long, k As Long
ReDim aResult(1 To &H100000, 1 To 1)
For i = 1 To UBound(aCol, 1)
    ListPermutations "", aCol(i), aResult, k
    If k >= &H100000 Then Exit For
Next
If k < UBound(aResult, 1) Then
    ReDim aFinalResult(1 To k, 1 To 1)
    For i = 1 To k
        aFinalResult(i, 1) = aResult(i, 1)
    Next
    GetResult = aFinalResult
Else
    GetResult = aResult
End If
End Function
Sub ListPermutations(ByVal sStr1 As String, ByVal sStr2 As String, ByRef aResult As Variant, ByRef k As Long)
    Dim i As Long, lLength As Long
    If sStr1 = "0" Then Exit Sub
    If k >= &H100000 Then Exit Sub
    lLength = Len(sStr2)
    If lLength < 2 Then
        If k < &H100000 Then
            k = k + 1
            aResult(k, 1) = sStr1 & sStr2
            If k = &H100000 Then aResult(k, 1) = "ect..."
        End If
    Else
        For i = 1 To lLength
            If InStr(sStr2, Mid(sStr2, i, 1)) = i Then
                ListPermutations sStr1 & Mid(sStr2, i, 1), Left(sStr2, i - 1) & Right(sStr2, lLength - i), aResult, k
            End If
        Next
    End If
End Sub
''
Sub Test()
    Dim aArr As Variant, dT As Double
    Range("A:A").ClearContents
    dT = Timer
    aArr = GetNumbers(22, 8)
    MsgBox Timer - dT
'    Application.ScreenUpdating = False
'    Range("A1:A" & UBound(aArr, 1)).Value = aArr
'    Application.ScreenUpdating = True
End Sub
 
Upvote 0
SA_DQ đã viết:
Tự sản, tự tiêu:
PHP: 
Sub Tong6KiSo_27()
 Dim J1 As Integer, J2 As Integer, J3 As Integer, J4 As Integer, J5 As Integer, J6 As Integer, Tmr As Double, W As Long
 Dim Tong6   As Long, Tmp As Integer

 ReDim Arr(1 To 8001, 1 To 1) As Long:              [B2].CurrentRegion.ClearContents
 Tmr = Timer()
 For J1 = 1 To 9
    For J2 = 0 To 9
        If J2 <> J1 Then
            For J3 = 0 To 9
                If J3 <> J2 And J3 <> J1 Then
                    For J4 = 0 To 9
                        If J4 <> J1 And J4 <> J2 And J4 <> J3 Then
                            For J5 = 1 To 9
                                If J5 <> J1 And J5 <> J2 And J5 <> J3 And J5 <> J4 Then
                                    For J6 = 0 To 9
                                        If J6 <> J1 And J6 <> J2 And J6 <> J3 And J6 <> J4 And J6 <> J5 Then
                                            Tong6 = J1 + J2 + J3 + J4 + J5 + J6
                                            If Tong6 = 27 Then
                                                W = W + 1
                                                If W > 7000 Then
                                                    Tmp = Tmp + 1:                  On Error GoTo GPE
                            Arr(Tmp, 1) = J1 * 100000 + J2 * 10000 + J3 * 1000 + J4 * 100 + J5 * 10 + J6
                                                End If
                                            End If
                                        End If
                                    Next J6
                                End If
                            Next J5
                        End If
                    Next J4
                End If
            Next J3
        End If
    Next J2
 Next J1
GPE: [B1].Value = Timer() - Tmr:                    [B2].Resize(Tmp).Value = Arr()
End Sub
Nhấp chuột vào đây để mở rộng...
Kết quả thiếu khá nhiều, có 11.640 giá trị thỏa điều kiện
 
Upvote 0
Nếu mình vô hiệu hóa 4 dòng lệnh:

Mã: 
                   Rem                            If W > 7000 Then    '
                    Rem                                Tmp = Tmp + 1:                  On Error GoTo GPE
                    Rem        Arr(Tmp, 1) = J1 * 100000 + J2 * 10000 + J3 * 1000 + J4 * 100 + J5 * 10 + J6
                    Rem                            End If              '
Thì đáp án W được ghi ra chỉ là 10 320 (?)
 
Upvote 0
SA_DQ đã viết:
Nếu mình vô hiệu hóa 4 dòng lệnh:

Mã: 
                   Rem                            If W > 7000 Then    '
                    Rem                                Tmp = Tmp + 1:                  On Error GoTo GPE
                    Rem        Arr(Tmp, 1) = J1 * 100000 + J2 * 10000 + J3 * 1000 + J4 * 100 + J5 * 10 + J6
                    Rem                            End If              '
Thì đáp án W được ghi ra chỉ là 10 320 (?)
Nhấp chuột vào đây để mở rộng...
Chỉnh tiếp vòng for
For J5 = 1 To 9
sẽ có 11.640 kết quả
 
Upvote 0
Với code này, tôi được tất cả 21,652 số.
Bài toán này, ngoài phần ghi kết quả thì chỉ dùng con toán số nguyên, tương đối hiệu quả.

Sub t()
Const SOKYTU = 6
Const SOTONG = 24
Dim so As Long, soN As Long ' số được xét
Dim tong As Long, digt As Long ' biến dùng để xét số
Dim totNum As Long ' tổng các số tìm được
Dim a(1 To 60000, 1 To 1) As Long ' mảng kết quả
For so = 10 ^ (SOKYTU - 1) To (10 ^ SOKYTU) - 1
soN = so
tong = 0
Do While soN > 0
digt = soN Mod 10
If digt = 0 Then GoTo Nxt_Number ' chứa 0, không đạt
tong = tong + digt
soN = soN \ 10
Loop
If tong <> SOTONG Then GoTo Nxt_Number ' số không đạt
totNum = totNum + 1
a(totNum, 1) = so
Nxt_Number:
Next so
[a1].Resize(totNum, 1).Value = a
MsgBox totNum ' hiển thị 21652
End Sub

1637395135231.png
 
Upvote 0
Đề 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
PHP: 
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
Mã: 
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​
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
Trả lời
6
Đọc
121
Tuấn Bụng Bự
Tuấn Bụng Bự
C
Code Lọc Dữ Liệu
Trả lời
10
Đọc
110
Cúc Hr
C
Y
Cách ẩn công thức 1 ô trong sheet
Trả lời
8
Đọc
81
hoangminhtien
hoangminhtien
vuha
  • Question
Lỗi chọn dòng thứ 6 trong sheet được chọn: rows("6:6").select
Trả lời
12
Đọc
133
ptm0412
ptm0412
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
12
Đọc
19K
cantl
C
N
Giúp sửa mã code
Trả lời
4
Đọc
96
ptm0412
ptm0412
Nguyencaocuong86
Tô màu dữ liệu trùng lặp trong excel.
Trả lời
10
Đọc
116
Nguyencaocuong86
Nguyencaocuong86
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
0
Đọc
32
zarra
zarra
Hoangquyenbong
  • Question
Nhờ viết code lọc dữ liệu tại các sheet khác nhau.
Trả lời
12
Đọc
141
Hoangquyenbong
Hoangquyenbong
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
10 11 12
Trả lời
236
Đọc
12K
Ryder
Ryder
D
Giúp em công thức lấy mã vật tư gồm 14 số?
Trả lời
3
Đọc
86
hoangminhtien
hoangminhtien
HeSanbi
  • Đã giải quyết
HÀM FITROW - Co giãn dòng tự động tối ưu nhất cho Excel v2.43 (*14/10/2024)
    • Thích
    • Yêu thích
2 3
Trả lời
48
Đọc
21K
HeSanbi
HeSanbi
L
Dùng vlookup đưa kết quả không được
Trả lời
19
Đọc
298
họ nguyễn tên thùy
họ nguyễn tên thùy
Ha Manh-LD
Thêm dòng cho 2 bảng cùng lúc
Trả lời
0
Đọc
48
Ha Manh-LD
Ha Manh-LD
T
Tối ưu hóa hàm lấy dữ liệu từ bảng Tổng sang bảng chi tiết
Trả lời
1
Đọc
125
Hoàng Tuấn 868
H
T
Ký tự đặc biệt đại diện cho các ký tự khác trong vba là gì
Trả lời
7
Đọc
254
VetMini
V
dunghtgiga
Tính bốn tuần cho một tháng
Trả lời
7
Đọc
221
Tuấn Bụng Bự
Tuấn Bụng Bự
N
Tạo, sử dụng Automation Add-in trong Excel bằng Visual C#
    • Thích
    • Yêu thích
Trả lời
19
Đọc
1K
dovandung
D
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
6
Đọc
248
Decepticon
D
keandanh141
Hướng dẫn hàm số tạo số ngẫu nhiên sao cho tổng bằng đúng 1 số
Trả lời
9
Đọc
228
CHAOQUAY
C
Xem thêm…

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

Back
Top Bottom