Tìm các con số có tổng bằng 1 con số cho trước

Quang_Hải · 17/3/13

Các anh chị vui lòng hướng dẫn cách viết code để tìm ra những con số có tổng bằng 1 con số cho trước. Mình đã mày mò cả buổi mà chưa tìm ra cách giải.
Vui lòng xem file đính kèm có kết quả tạm làm thủ công.

trung.aof · 17/3/13

Anh cải tiến cái này cho chạy nhanh hơn xem thế nào:
Sub Tinh()
Dim i1 As Integer, i2 As Integer, i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer, i7 As Integer, i8 As Integer, i9 As Integer, i10 As Integer
For i1 = 1 To 10

For i2 = i1 + 1 To 10

For i3 = i2 + 1 To 10

For i4 = i3 + 1 To 10

For i5 = i4 + 1 To 10

For i6 = i5 + 1 To 10

For i7 = i6 + 1 To 10

For i8 = i7 + 1 To 10

For i9 = i8 + 1 To 10

For i10 = i9 + 1 To 10
If Range("B" & i1) + Range("B" & i2) + Range("B" & i3) + Range("B" & i4) + Range("B" & i5) + Range("B" & i6) + Range("B" & i7) + Range("B" & i8) + Range("B" & i9) + Range("B" & i10) = Range("A1") Then
MsgBox 10
Cells(7, Sheet1.Range("B7").End(xlToRight).Column + 1) = Range("B" & i1)
Cells(8, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i2)
Cells(9, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i3)
Cells(10, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i4)
Cells(11, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i5)
Cells(12, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i6)
Cells(13, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i7)
Cells(14, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i8)
Cells(15, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i9)
Cells(16, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i10)
End If
Next
If Range("B" & i1) + Range("B" & i2) + Range("B" & i3) + Range("B" & i4) + Range("B" & i5) + Range("B" & i6) + Range("B" & i7) + Range("B" & i8) + Range("B" & i9) = Range("A1") Then
Cells(7, Sheet1.Range("B7").End(xlToRight).Column + 1) = Range("B" & i1)
Cells(8, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i2)
Cells(9, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i3)
Cells(10, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i4)
Cells(11, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i5)
Cells(12, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i6)
Cells(13, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i7)
Cells(14, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i8)
Cells(15, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i9)
End If
Next
If Range("B" & i1) + Range("B" & i2) + Range("B" & i3) + Range("B" & i4) + Range("B" & i5) + Range("B" & i6) + Range("B" & i7) + Range("B" & i8) = Range("A1") Then
Cells(7, Sheet1.Range("B7").End(xlToRight).Column + 1) = Range("B" & i1)
Cells(8, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i2)
Cells(9, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i3)
Cells(10, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i4)
Cells(11, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i5)
Cells(12, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i6)
Cells(13, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i7)
Cells(14, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i8)
End If
Next
If Range("B" & i1) + Range("B" & i2) + Range("B" & i3) + Range("B" & i4) + Range("B" & i5) + Range("B" & i6) + Range("B" & i7) = Range("A1") Then
Cells(7, Sheet1.Range("B7").End(xlToRight).Column + 1) = Range("B" & i1)
Cells(8, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i2)
Cells(9, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i3)
Cells(10, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i4)
Cells(11, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i5)
Cells(12, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i6)
Cells(13, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i7)
End If
Next
If Range("B" & i1) + Range("B" & i2) + Range("B" & i3) + Range("B" & i4) + Range("B" & i5) + Range("B" & i6) = Range("A1") Then
Cells(7, Sheet1.Range("B7").End(xlToRight).Column + 1) = Range("B" & i1)
Cells(8, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i2)
Cells(9, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i3)
Cells(10, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i4)
Cells(11, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i5)
Cells(12, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i6)
End If
Next
If Range("B" & i1) + Range("B" & i2) + Range("B" & i3) + Range("B" & i4) + Range("B" & i5) = Range("A1") Then
MsgBox i1 & Chr(13) & i2 & Chr(13) & i3 & Chr(13) & i4 & Chr(13) & i5 & Chr(13) & i6 & Chr(13) & i7 & Chr(13) & i8 & Chr(13) & i9 & Chr(13) & i10
Cells(7, Sheet1.Range("B7").End(xlToRight).Column + 1) = Range("B" & i1)
Cells(8, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i2)
Cells(9, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i3)
Cells(10, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i4)
Cells(11, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i5)
End If
Next
If Range("B" & i1) + Range("B" & i2) + Range("B" & i3) + Range("B" & i4) = Range("A1") Then
Cells(7, Sheet1.Range("B7").End(xlToRight).Column + 1) = Range("B" & i1)
Cells(8, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i2)
Cells(9, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i3)
Cells(10, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i4)
End If
Next
If Range("B" & i1) + Range("B" & i2) + Range("B" & i3 + 1) = Range("A1") Then
Cells(7, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i1)
Cells(8, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i2)
Cells(9, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i3)
End If
Next
If Range("B" & i1) + Range("B" & i2) = Range("A1") Then
Cells(7, Sheet1.Range("B7").End(xlToRight).Column + 1) = Range("B" & i1)
Cells(8, Sheet1.Range("B7").End(xlToRight).Column) = Range("B" & i2)
End If
Next
If Range("B" & i1) = Range("A1") Then
MsgBox 1
Cells(7, Sheet1.Range("B7").End(xlToRight).Column + 1) = Range("B" & i1)
End If
Next

End Sub

Quang_Hải · 18/3/13

trung.aof đã viết:
Anh cải tiến cái này cho chạy nhanh hơn xem thế nào:

Cảm ơn bạn rất nhiều vì đã kiên nhẫn viết 1 code dài như thế giúp mình. Nhưng mình đã thử code mà không ra được kết quả. Đang kiểm tra lại và tìm hướng xử lý.

ndu96081631 · 18/3/13

quanghai1969 đã viết:
Các anh chị vui lòng hướng dẫn cách viết code để tìm ra những con số có tổng bằng 1 con số cho trước. Mình đã mày mò cả buổi mà chưa tìm ra cách giải.
Vui lòng xem file đính kèm có kết quả tạm làm thủ công.

Nếu chỉ cần tìm ra 1 kết quả nào đó thì Solver là lựa chọn thích hợp... Còn để "vét cạn" mọi trường hợp thì... Ẹc.. Ẹc... chưa nghĩ ra (tổ hợp giữa chúng ra cả rừng trường hợp)

ndu96081631 · 18/3/13

Nếu luôn luôn tìm "1 bộ" 5 phần tử thì chắc là vầy:

Mã:

Sub Main()
   Dim n1 As Long, n2 As Long, n3 As Long, n4 As Long, n5 As Long, lC As Long
   Dim arr, res()
   Dim tmp As Double
   arr = Range("B1:B10").Value
   ReDim res(1 To 5, 1 To 1)
   For n1 = 1 To 6
     For n2 = n1 + 1 To 7
       For n3 = n2 + 1 To 8
         For n4 = n3 + 1 To 9
           For n5 = n4 + 1 To 10
             tmp = arr(n1, 1) + arr(n2, 1) + arr(n3, 1) + arr(n4, 1) + arr(n5, 1)
             If tmp = 620 Then
               lC = lC + 1
               ReDim Preserve res(1 To 5, 1 To lC)
               res(1, lC) = arr(n1, 1)
               res(2, lC) = arr(n2, 1)
               res(3, lC) = arr(n3, 1)
               res(4, lC) = arr(n4, 1)
               res(5, lC) = arr(n5, 1)
             End If
           Next
         Next
       Next
     Next
   Next
   If lC Then Range("D1:D5").Resize(, lC).Value = res
End Sub

trung.aof · 18/3/13

Anh xem file đính kèm đấy có được không

ndu96081631 · 18/3/13

trung.aof đã viết:
Anh xem file đính kèm đấy có được không

File này mà đi áp dụng chắc bấm nút cái xong phải đi uống cafe để chờ chắc?
Chậm quá

trung.aof · 18/3/13

Em làm cái đấy thì hơi chậm nhưng mà nó cho kết quả đầy đủ thầy ạ! Nếu thay code để cho A1 cố định thì thời gian khoảng hơn 1 giây thôi.

Quang_Hải · 18/3/13

ndu96081631 đã viết:
Nếu luôn luôn tìm "1 bộ" 5 phần tử thì chắc là vầy:

Mã:

Sub Main() End Sub

Code của anh chạy tốt cho trường hợp mình biết chắc là 1 bộ 5 phần tử. Em đang nghiên cứu thuật toán đệ quy để giải bài này. Vì vấn đề chính là không biết trước gồm bao nhiêu phần tử để cho ra kết quả.
Hiện giờ em đang có 1 danh sách con số khoảng 20 dãy số. Và có 1 con số được tổng gồm vài con số trong dãy số đó. Giờ phải mò ra xem khả năng là những số nào.

trung.aof đã viết:
Anh xem file đính kèm đấy có được không

Ý tưởng rất hay. Dù chưa đáp ứng được nhu cầu nhưng xem ra cũng gợi ý cho mình thuật toán

ndu96081631 · 18/3/13

quanghai1969 đã viết:
Code của anh chạy tốt cho trường hợp mình biết chắc là 1 bộ 5 phần tử. Em đang nghiên cứu thuật toán đệ quy để giải bài này. Vì vấn đề chính là không biết trước gồm bao nhiêu phần tử để cho ra kết quả.
Hiện giờ em đang có 1 danh sách con số khoảng 20 dãy số. Và có 1 con số được tổng gồm vài con số trong dãy số đó. Giờ phải mò ra xem khả năng là những số nào.

Ái chà! Đã không biết bộ bao nhiêu số, lại còn muốn vét cạn mọi trường hợp thì... khoai nha
Cứ nghiên cứu thử, có gì tôi học hỏi với
(bài dạng này ngán quá)

huuthang_bd · 18/3/13

Anh thử cái này xem.

Quang_Hải · 18/3/13

huuthang_bd đã viết:
Anh thử cái này xem.

Kết quả chuẩn rồi. Nhưng đọc mãi cũng không hiểu ra nổi thuật toán.
Cảm ơn bạn huuthang_bd

Quang_Hải · 18/3/13

Các bạn xem 1 cách giải khác cũng rất hay của 1 bạn trên diễn đàn. Và mình cũng đang ngẫn ngơ với thuật toán này.

siwtom · 18/3/13

quanghai1969 đã viết:
Các anh chị vui lòng hướng dẫn cách viết code để tìm ra những con số có tổng bằng 1 con số cho trước. Mình đã mày mò cả buổi mà chưa tìm ra cách giải.
Vui lòng xem file đính kèm có kết quả tạm làm thủ công.

Thuật toán của tôi đơn giản thôi.
Giả sử ta có N số khác nhau: a1, a2, ..., aN. Có thể lập được 2^N - 1 chuỗi khác nhau có N ký tự "0" hoặc "1" - ít nhất 1 ký tự = "1". Đó chẳng qua là (2^N - 1) số từ 1 tới (2^N - 1) được viết ở dạng bít. Vd. N = 2 (a1, a2) thì ta có 3 chuỗi ứng với 3 số từ 1 tới 2^2 - 1 = 3 là "01", "10" và "11"
Với mỗi chuỗi kể trên ta tính tổng các số ở dãy cho trước mà ứng với chúng ký tự trong chuỗi là 1. Nếu con số này = số cho trước thì ta lấy các con số ứng với chuỗi.
VD. ta có dãy 9 số cho trước (N = 9): 1, 2, 3, 4, 5, 6, 7, 8, 9
=> với chuỗi "001000110" ta tính số = 3 + 7 + 8 = 18
--------------
Xin nhờ test hộ cả tốc độ của code.

Quang_Hải · 18/3/13

siwtom đã viết:
Thuật toán của tôi đơn giản thôi.
Giả sử ta có N số khác nhau: a1, a2, ..., aN. Có thể lập được 2^N - 1 chuỗi khác nhau có N ký tự "0" hoặc "1" - ít nhất 1 ký tự = "1". Đó chẳng qua là (2^N - 1) số từ 1 tới (2^N - 1) được viết ở dạng bít. Vd. N = 2 (a1, a2) thì ta có 3 chuỗi ứng với 3 số từ 1 tới 2^2 - 1 = 3 là "01", "10" và "11"
Với mỗi chuỗi kể trên ta tính tổng các số ở dãy cho trước mà ứng với chúng ký tự trong chuỗi là 1. Nếu con số này = số cho trước thì ta lấy các con số ứng với chuỗi.
VD. ta có dãy 9 số cho trước (N = 9): 1, 2, 3, 4, 5, 6, 7, 8, 9
=> với chuỗi "001000110" ta tính số = 3 + 7 + 8 = 18
--------------
Xin nhờ test hộ cả tốc độ của code.

Về kết quả thì chính xác như mong đợi. Về tốc độ thì hình như không nhanh bằng code trong bài 13. Về thuật toán thì em hỏng có dám có ý kiến gì hết vì có hiểu tí gì đâu.
Nhưng tin chắc sẽ có 1 ngày em hiểu thôi. Cảm ơn anh.

siwtom · 18/3/13

quanghai1969 đã viết:
Về kết quả thì chính xác như mong đợi. Về tốc độ thì hình như không nhanh bằng code trong bài 13.

Thế thì hơi lạ.
Tôi lấy bài #13 --> bỏ Worksheet_Change. Thủ tục Kiem Tra được khởi động bởi nút "KiemTra"
Tôi đính thêm module có code của tôi. Thủ tục test của tôi được khởi động bởi nút "Test"
Kết quả đo tốc độ như sau:

KiemTra: 0,681
test: 0,19
KiemTra: 0,711
test: 0,12
KiemTra: 0,691
test: 0,09
KiemTra: 0,681
test: 0,09
KiemTra: 0,791
test: 0,08
KiemTra: 0,721
test: 0,08
---------------
Bây giờ tôi nhập thêm vào B12:B19 các giá trị 1, 2, 3, 4, 5, 6, 7, -130 và nhập vào A1 = 0 thì có các tốc độ:

KiemTra: 26,518
test: 23,434
------------
Mọi người kiểm tra lại hộ.

Quang_Hải · 19/3/13

siwtom đã viết:
Thế thì hơi lạ.
Tôi lấy bài #13 --> bỏ Worksheet_Change. Thủ tục Kiem Tra được khởi động bởi nút "KiemTra"
Tôi đính thêm module có code của tôi. Thủ tục test của tôi được khởi động bởi nút "Test"
Kết quả đo tốc độ như sau:

KiemTra: 0,681
test: 0,19
KiemTra: 0,711
test: 0,12
KiemTra: 0,691
test: 0,09
KiemTra: 0,681
test: 0,09
KiemTra: 0,791
test: 0,08
KiemTra: 0,721
test: 0,08
---------------
Bây giờ tôi nhập thêm vào B12:B19 các giá trị 1, 2, 3, 4, 5, 6, 7, -130 và nhập vào A1 = 0 thì có các tốc độ:

KiemTra: 26,518
test: 23,434
------------
Mọi người kiểm tra lại hộ.

Kể cũng lạ. Em test tới test lui và tăng thêm các con số lên thử thì thấy sub kiemtra cũng nhanh hơn 1 chút xíu dù không đáng là bao nhiêu. Em thêm 1 > 10 và -130, A1=0 thì kiemtra cho ra 38s, và test cho ra khoảng 42s

ptm0412 · 19/3/13

Kết quả test 10 lần:

KiemTra: ,047
test: ,031
KiemTra: ,047
test: ,031
KiemTra: ,047
test: ,032
KiemTra: ,047
test: ,031
KiemTra: ,032
test: ,031
KiemTra: ,047
test: ,031
KiemTra: ,047
test: ,031
KiemTra: ,032
test: ,015
KiemTra: ,047
test: ,031
KiemTra: ,031
test: ,031

ptm0412 · 19/3/13

Điền thêm 3 số vào cột số:

KiemTra: ,141
test: ,171
KiemTra: ,156
test: ,187
KiemTra: ,125
test: ,172
KiemTra: ,156
test: ,203
KiemTra: ,156
test: ,171
KiemTra: ,141
test: ,172
KiemTra: ,125
test: ,172
KiemTra: ,141
test: ,156
KiemTra: ,171
test: ,172
KiemTra: ,141
test: ,172

Thêm 3 số nữa:

KiemTra: 1,092
test: 1,56
KiemTra: 1,092
test: 1,56
KiemTra: 1,092
test: 1,545
KiemTra: 1,107
test: 1,56
KiemTra: 1,092
test: 1,56
KiemTra: 1,092
test: 1,56
KiemTra: 1,076
test: 1,56
KiemTra: 1,124
test: 1,545
KiemTra: 1,077
test: 1,56
KiemTra: 1,107
test: 1,56

Dường như code Test với dữ liệu tăng dần sẽ càng chậm đi.

siwtom · 19/3/13

ptm0412 đã viết:
Dường như code Test với dữ liệu tăng dần sẽ càng chậm đi.

Ừ đúng. Trên máy tôi tôi test thấy với cột B có <= 19 số thì test nhanh hơn, nhưng nếu cột B có > 19 số thì test chậm hơn.

Tìm các con số có tổng bằng 1 con số cho trước

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

File đính kèm

Thành viên chính thức

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

Huyền thoại GPE

Huyền thoại GPE

File đính kèm

Thành viên chính thức

File đính kèm

Huyền thoại GPE

Thành viên chính thức

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

Huyền thoại GPE

Chuyên gia GPE

File đính kèm

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

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

File đính kèm

Thành viên gắn bó

File đính kèm

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

Thành viên gắn bó

File đính kèm

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

Bad Excel Member

Bad Excel Member

Thành viên gắn bó