Chọn các số trong dãy số để ra 1 số tổng cho trước

MinhKhai

Giải pháp Ếc-xào
Tham gia ngày
16 Tháng tư 2008
Bài viết
845
Được thích
533
Điểm
860
Chào các anh chị trong diễn đàn.

Tôi có nhu cầu như sau: Tôi có 1 dãy số (gồm nhiều ô, các ô có giá trị bất kỳ). Tôi muốn tìm ra những ô nào trong dãy đó cộng với nhau sẽ ra 1 giá trị cho trước. Mỗi ô chỉ được cộng 1 lần. Không cần tìm hết các phương án thỏa mãn, chỉ cần tìm được 1 đáp án là đạt yêu cầu

Mong mọi người dùng giúp đỡ
 

File đính kèm

maytinhvp01

Thành viên thường trực
Tham gia ngày
27 Tháng bảy 2013
Bài viết
389
Được thích
179
Điểm
395
Nơi ở
VĩnhYên_VP
Chào các anh chị trong diễn đàn.

Tôi có nhu cầu như sau: Tôi có 1 dãy số (gồm nhiều ô, các ô có giá trị bất kỳ). Tôi muốn tìm ra những ô nào trong dãy đó cộng với nhau sẽ ra 1 giá trị cho trước. Mỗi ô chỉ được cộng 1 lần. Không cần tìm hết các phương án thỏa mãn, chỉ cần tìm được 1 đáp án là đạt yêu cầu

Mong mọi người dùng giúp đỡ
Mình làm cho bạn nhé. nhưng phải
Mã:
Sub Chon2so()
Dim n As Long, k As Long, i As Long, ran As Range
k = InputBox(" nhap so can so sanh")
n = Worksheets("Sheet1").[C6500].End(xlUp).Row
For i = 3 To n
    For Each ran In Worksheets("Sheet1").Range("C2:C" & n)
        If Range("C" & i).Value + ran.Value = k Then
        MsgBox " so thu nhat co vi tri dong la:" & i & " so thu 2 co vi tri dong la:" & ran.Row
        Exit Sub
        End If
    Next
   
Next
MsgBox (" khong co 2 so thoa man")
End Sub
code để bạn thử đó
 

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia ngày
5 Tháng sáu 2008
Bài viết
30,723
Được thích
53,522
Điểm
11,910
Chào các anh chị trong diễn đàn.

Tôi có nhu cầu như sau: Tôi có 1 dãy số (gồm nhiều ô, các ô có giá trị bất kỳ). Tôi muốn tìm ra những ô nào trong dãy đó cộng với nhau sẽ ra 1 giá trị cho trước. Mỗi ô chỉ được cộng 1 lần. Không cần tìm hết các phương án thỏa mãn, chỉ cần tìm được 1 đáp án là đạt yêu cầu

Mong mọi người dùng giúp đỡ
Bài này phải dùng Solver mới xong!
Xem bài tương tự:
http://www.giaiphapexcel.com/forum/...-lọc-danh-sách-khách-hàng&p=232000#post232000
 

sealand

Thành viên gạo cội
Tham gia ngày
16 Tháng năm 2008
Bài viết
4,877
Được thích
7,632
Điểm
860
Tuổi
61
Nơi ở
Hải Phòng
Bạn thử Code này xem sao: (Mình nhầm mất rồi cứ nghĩ là tìm 2 ô)

Mã:
Sub FindCell()
Dim Tm, Dk, i, j
Tm = [C3:C248]: Dk = [H4]
For i = 1 To UBound(Tm, 1)
For j = i + 1 To UBound(Tm, 1)
If Tm(i, 1) + Tm(j, 1) = Dk Then
MsgBox "Cell C" & i + 2 & " va Cell C" & j + 2
Exit Sub
End If
Next: Next
MsgBox "Khong tim thay"
End Sub
Hoặc dùng Hàm UDF:

Mã:
Function MyFor(Rg As Range, Dk As Long)
Dim Tm, i, j
Tm = Rg
MyFor = "None Value"
For i = 1 To UBound(Tm, 1)
For j = i + 1 To UBound(Tm, 1)
If Tm(i, 1) + Tm(j, 1) = Dk Then
MyFor = "= " & Rg.Cells(i, 1).Address & " + " & Rg.Cells(j, 1).Address
Exit Function
End If
Next: Next
End Function

Tại ô H3 nhập: =MyFor(C3:C1000,H4)
 
Lần chỉnh sửa cuối:

huuthang_bd

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
7,951
Được thích
9,288
Điểm
860
Nơi ở
TP.HCM
Bạn thử Code này xem sao:

Mã:
Sub FindCell()
Dim Tm, Dk, i, j
Tm = [C3:C248]: Dk = [H4]
For i = 1 To UBound(Tm, 1)
For j = i + 1 To UBound(Tm, 1)
If Tm(i, 1) + Tm(j, 1) = Dk Then
MsgBox "Cell C" & i + 2 & " va Cell C" & j + 2
Exit Sub
End If
Next: Next
MsgBox "Khong tim thay"
End Sub
Mình làm cho bạn nhé. nhưng phải
Mã:
Sub Chon2so()
Dim n As Long, k As Long, i As Long, ran As Range
k = InputBox(" nhap so can so sanh")
n = Worksheets("Sheet1").[C6500].End(xlUp).Row
For i = 3 To n
    For Each ran In Worksheets("Sheet1").Range("C2:C" & n)
        If Range("C" & i).Value + ran.Value = k Then
        MsgBox " so thu nhat co vi tri dong la:" & i & " so thu 2 co vi tri dong la:" & ran.Row
        Exit Sub
        End If
    Next
   
Next
MsgBox (" khong co 2 so thoa man")
End Sub
code để bạn thử đó
Bài toán này là tìm những ô để cộng với nhau ra một giá trị cho trước mà. Đâu phải là cộng hai ô đâu.
 

maytinhvp01

Thành viên thường trực
Tham gia ngày
27 Tháng bảy 2013
Bài viết
389
Được thích
179
Điểm
395
Nơi ở
VĩnhYên_VP
Bài toán này là tìm những ô để cộng với nhau ra một giá trị cho trước mà. Đâu phải là cộng hai ô đâu.
Nhưng yêu cầu là chỉ cần tìm ra một cặp số thôi đã thảo mãn yêu cầu mà. Hơn nữa bạn đó biết vô đây hỏi chác là biết chút về VBA rùi nên viết để bạn đó có được một cách giải quyết đã." Còn gặp phải các cao thử thì luôn tìm ra cái tối ưu hóa cái đó mình biết" Như vậy bạn cho mình hỏi code của mình đã thỏa mãn yêu cầu chưa? " hỏi về mục đính ra kết quả"
 

VetMini

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
10,348
Được thích
12,606
Điểm
1,560
Nhưng yêu cầu là chỉ cần tìm ra một cặp số thôi đã thảo mãn yêu cầu mà. Hơn nữa bạn đó biết vô đây hỏi chác là biết chút về VBA rùi nên viết để bạn đó có được một cách giải quyết đã." Còn gặp phải các cao thử thì luôn tìm ra cái tối ưu hóa cái đó mình biết" Như vậy bạn cho mình hỏi code của mình đã thỏa mãn yêu cầu chưa? " hỏi về mục đính ra kết quả"
Đề bài dùng từ "những" chứ không phải "cặp". Có nhĩa là nếu không có cặp nào thoả mãn thì đấp án phải nới rộng ra 3, 4 ...

Như vậy những lời giải chỉ tìm cặp là không đạt yêu cầu.

Đó là chỉ nói chuyện yêu cầu. Riêng về "tối ưu" cũng có hai vấn đề:

1. Tối ưu lời giải, tức là nếu không có nhóm nào cộng lại ra đúng thì lằm sao? Trả về 0 hay cố gắng tìm nhóm có tổng gần nhất?

2. Tối ưu giải thuật, cái này thuật toán rất cao.

Muốn giản dị chỉ có cách duy nhất là dùng solver.
Nếu mò trên mạng sẽ có một số add-ins khác (chính solver cũng là một add-in) làm công việc này. Từ khoá "knapsack problem", "bài toán xếp ba lô"
 

maytinhvp01

Thành viên thường trực
Tham gia ngày
27 Tháng bảy 2013
Bài viết
389
Được thích
179
Điểm
395
Nơi ở
VĩnhYên_VP
Đề bài dùng từ "những" chứ không phải "cặp". Có nhĩa là nếu không có cặp nào thoả mãn thì đấp án phải nới rộng ra 3, 4 ...

Như vậy những lời giải chỉ tìm cặp là không đạt yêu cầu.

Đó là chỉ nói chuyện yêu cầu. Riêng về "tối ưu" cũng có hai vấn đề:

1. Tối ưu lời giải, tức là nếu không có nhóm nào cộng lại ra đúng thì lằm sao? Trả về 0 hay cố gắng tìm nhóm có tổng gần nhất?

2. Tối ưu giải thuật, cái này thuật toán rất cao.

Muốn giản dị chỉ có cách duy nhất là dùng solver.
Nếu mò trên mạng sẽ có một số add-ins khác (chính solver cũng là một add-in) làm công việc này. Từ khoá "knapsack problem", "bài toán xếp ba lô"
Đúng rùi mình đã hiểu vấn đề rùi. Thank
 

huuthang_bd

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
7,951
Được thích
9,288
Điểm
860
Nơi ở
TP.HCM
Làm thử vầy. Hình như thuật toán này gọi là thuật toán vét cạn.
PHP:
Function SumF(Num As Double, ParamArray Args() As Variant) As String
Dim Data(), Cll As Range, n As Long, k As Long, Arr(), Total As Double
For i = LBound(Args) To UBound(Args)
    For Each Cll In Args(i)
        If Val(Cll.Value) <> 0 Then
            n = n + 1
            ReDim Preserve Data(1 To 2, 1 To n)
            Data(1, n) = Val(Cll.Value)
            Data(2, n) = Cll.Address(0, 0)
        End If
    Next
Next
ReDim Arr(1 To 1)
Arr(1) = 1
Total = Data(1, 1)
n = 1
k = 1
Do While Num <> Total
    If Arr(1) = UBound(Data, 2) Then
        SumF = "#N/A"
        Exit Function
    End If
    If Total > Num Then
        If k = UBound(Data, 2) Then
            k = Arr(n - 1) + 1
            Total = Total - Data(1, Arr(n)) - Data(1, Arr(n - 1)) + Data(1, k)
            n = n - 1
            Arr(n) = k
        Else
            k = k + 1
            Total = Total - Data(1, Arr(n)) + Data(1, k)
            Arr(n) = k
        End If
    Else
        If k = UBound(Data, 2) Then
            k = Arr(n - 1) + 1
            Total = Total - Data(1, Arr(n)) - Data(1, Arr(n - 1)) + Data(1, k)
            n = n - 1
            Arr(n) = k
        Else
            k = k + 1
            Total = Total + Data(1, k)
            n = n + 1
            ReDim Preserve Arr(1 To n)
            Arr(n) = k
        End If
    End If
Loop
For k = 1 To n
    SumF = SumF & "+" & Data(2, Arr(k))
Next
SumF = Replace(SumF, "+", "=", 1, 1)
End Function
 

File đính kèm

MinhKhai

Giải pháp Ếc-xào
Tham gia ngày
16 Tháng tư 2008
Bài viết
845
Được thích
533
Điểm
860
Đề bài dùng từ "những" chứ không phải "cặp". Có nhĩa là nếu không có cặp nào thoả mãn thì đấp án phải nới rộng ra 3, 4 ...

Như vậy những lời giải chỉ tìm cặp là không đạt yêu cầu.


"

Đúng là ý của tôi là như vậy. Tìm tổng của các nhóm số. Nhóm có bao nhiêu phần tử tuỳ ý, miễn mỗi phần tử không lặp lại
 

MinhKhai

Giải pháp Ếc-xào
Tham gia ngày
16 Tháng tư 2008
Bài viết
845
Được thích
533
Điểm
860
Làm thử vầy. Hình như thuật toán này gọi là thuật toán vét cạn.
Tuyệt vời, đúng ý của em. Cảm ơn bác rất nhiều.

Do em mới tập tành về VBA, nên em chưa hiểu rõ cách bác cho code "chọn lọc" như thế nào. Bác "diễn giải nôm na" được không ạ
 

huuthang_bd

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
7,951
Được thích
9,288
Điểm
860
Nơi ở
TP.HCM
Tuyệt vời, đúng ý của em. Cảm ơn bác rất nhiều.

Do em mới tập tành về VBA, nên em chưa hiểu rõ cách bác cho code "chọn lọc" như thế nào. Bác "diễn giải nôm na" được không ạ
Nôm na là thế này. Tôi giả sử dãy số của bạn gồm các số từ a đến z. Và tổng cho trước là Tổng

So a với tổng
Nếu a > tổng thì so b với tổng...
Nếu a < tổng thì so a + b với tổng
Nếu a + b > tổng thì so a + c với tổng...
Nếu a + b < tổng thì so a + b + c với tổng
...

Nếu a + ... + o + z <> tổng thì so a + ... + p với tổng
...

Cho đến khi tìm được tập số thỏa điều kiện.
 

bacute

Thành viên mới
Tham gia ngày
10 Tháng mười một 2006
Bài viết
32
Được thích
2
Điểm
665
Làm thử vầy. Hình như thuật toán này gọi là thuật toán vét cạn.
PHP:
Function SumF(Num As Double, ParamArray Args() As Variant) As String
Dim Data(), Cll As Range, n As Long, k As Long, Arr(), Total As Double
For i = LBound(Args) To UBound(Args)
    For Each Cll In Args(i)
        If Val(Cll.Value) <> 0 Then
            n = n + 1
            ReDim Preserve Data(1 To 2, 1 To n)
            Data(1, n) = Val(Cll.Value)
            Data(2, n) = Cll.Address(0, 0)
        End If
    Next
Next
ReDim Arr(1 To 1)
Arr(1) = 1
Total = Data(1, 1)
n = 1
k = 1
Do While Num <> Total
    If Arr(1) = UBound(Data, 2) Then
        SumF = "#N/A"
        Exit Function
    End If
    If Total > Num Then
        If k = UBound(Data, 2) Then
            k = Arr(n - 1) + 1
            Total = Total - Data(1, Arr(n)) - Data(1, Arr(n - 1)) + Data(1, k)
            n = n - 1
            Arr(n) = k
        Else
            k = k + 1
            Total = Total - Data(1, Arr(n)) + Data(1, k)
            Arr(n) = k
        End If
    Else
        If k = UBound(Data, 2) Then
            k = Arr(n - 1) + 1
            Total = Total - Data(1, Arr(n)) - Data(1, Arr(n - 1)) + Data(1, k)
            n = n - 1
            Arr(n) = k
        Else
            k = k + 1
            Total = Total + Data(1, k)
            n = n + 1
            ReDim Preserve Arr(1 To n)
            Arr(n) = k
        End If
    End If
Loop
For k = 1 To n
    SumF = SumF & "+" & Data(2, Arr(k))
Next
SumF = Replace(SumF, "+", "=", 1, 1)
End Function
Tôi không hiểu mấy về VBA, code này đã chỉ ra được địa chỉ ô thôi. Để dễ dàng nhận biết hơn nên chỉ ra các số đó và định dạng khác như là tô mầu hay chữ đậm thì tốt hơn. Mong mọi người xem xét.
 

huuthang_bd

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
7,951
Được thích
9,288
Điểm
860
Nơi ở
TP.HCM
Tôi không hiểu mấy về VBA, code này đã chỉ ra được địa chỉ ô thôi. Để dễ dàng nhận biết hơn nên chỉ ra các số đó và định dạng khác như là tô mầu hay chữ đậm thì tốt hơn. Mong mọi người xem xét.
Hàm SumF đó đã tạo ra một chuỗi công thức để có tổng bằng tổng đưa ra. Bạn chỉ cần chuyển nó thành công thức. Sau đó nếu muốn biết nó là tổng của những ô nào thì chỉ cần chọn ô đó và nhấn F2, các ô trong công thức sẽ được tô màu viền. Nếu tô màu sẽ gặp rắc rối khi có nhiều tổng khác nhau cùng tìm trên một vùng dữ liệu.
 

bacute

Thành viên mới
Tham gia ngày
10 Tháng mười một 2006
Bài viết
32
Được thích
2
Điểm
665
Hàm SumF đó đã tạo ra một chuỗi công thức để có tổng bằng tổng đưa ra. Bạn chỉ cần chuyển nó thành công thức. Sau đó nếu muốn biết nó là tổng của những ô nào thì chỉ cần chọn ô đó và nhấn F2, các ô trong công thức sẽ được tô màu viền. Nếu tô màu sẽ gặp rắc rối khi có nhiều tổng khác nhau cùng tìm trên một vùng dữ liệu.
Tôi hiểu và cũng nghĩ ra cách của bạn hướng dẫn. Tuy nhiên khi báo cáo các sếp hỏi "đồng nào mua mắm và đồng nào mua muối" thì chắc có lẽ tôi phải mang theo máy tính mới giải thích được bạn ạ. Dù gì thì sự giúp đỡ của bạn cũng đạt được 95% yêu cầu đặt ra, 5% còn lại là làm thủ công. Cám ơn và mong được tiếp thu ý kiến
 

huuthang_bd

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
7,951
Được thích
9,288
Điểm
860
Nơi ở
TP.HCM
Tôi không hiểu mấy về VBA, code này đã chỉ ra được địa chỉ ô thôi. Để dễ dàng nhận biết hơn nên chỉ ra các số đó và định dạng khác như là tô mầu hay chữ đậm thì tốt hơn. Mong mọi người xem xét.
Vì tôi thấy bạn khuyên chứ không phải bạn nhờ nên tôi đưa ra quan điểm của tôi thôi. Cái này chỉ cần biết sơ sơ về VBA thôi cũng có thể làm tô màu được.
 

nganguyen2027

Thành viên mới
Tham gia ngày
13 Tháng ba 2019
Bài viết
1
Được thích
0
Điểm
13
Tuổi
27
Các bác cho em hỏi tìm tổ hợp gồm 3,4,... thỏa mãn tổng cho trước thay vì tìm tổ hợp bất kỳ như trên không ạ. Ví dụ em muốn tìm tổ hợp gồm 13 số từ 64 số để ra 1 tổng cho trước thay vì kết quả ra tận 21 số có tổng như vậy. Nhờ cao kiến ạ.
 

sddemons

Thành viên mới
Tham gia ngày
11 Tháng năm 2019
Bài viết
1
Được thích
0
Điểm
13
Tuổi
23
Làm thử vầy. Hình như thuật toán này gọi là thuật toán vét cạn.
PHP:
Function SumF(Num As Double, ParamArray Args() As Variant) As String
Dim Data(), Cll As Range, n As Long, k As Long, Arr(), Total As Double
For i = LBound(Args) To UBound(Args)
    For Each Cll In Args(i)
        If Val(Cll.Value) <> 0 Then
            n = n + 1
            ReDim Preserve Data(1 To 2, 1 To n)
            Data(1, n) = Val(Cll.Value)
            Data(2, n) = Cll.Address(0, 0)
        End If
    Next
Next
ReDim Arr(1 To 1)
Arr(1) = 1
Total = Data(1, 1)
n = 1
k = 1
Do While Num <> Total
    If Arr(1) = UBound(Data, 2) Then
        SumF = "#N/A"
        Exit Function
    End If
    If Total > Num Then
        If k = UBound(Data, 2) Then
            k = Arr(n - 1) + 1
            Total = Total - Data(1, Arr(n)) - Data(1, Arr(n - 1)) + Data(1, k)
            n = n - 1
            Arr(n) = k
        Else
            k = k + 1
            Total = Total - Data(1, Arr(n)) + Data(1, k)
            Arr(n) = k
        End If
    Else
        If k = UBound(Data, 2) Then
            k = Arr(n - 1) + 1
            Total = Total - Data(1, Arr(n)) - Data(1, Arr(n - 1)) + Data(1, k)
            n = n - 1
            Arr(n) = k
        Else
            k = k + 1
            Total = Total + Data(1, k)
            n = n + 1
            ReDim Preserve Arr(1 To n)
            Arr(n) = k
        End If
    End If
Loop
For k = 1 To n
    SumF = SumF & "+" & Data(2, Arr(k))
Next
SumF = Replace(SumF, "+", "=", 1, 1)
End Function
bác ơi, mình đưa thuật toán vô VBA , lúc qua bên excel xuất macros nó yêu cầu macros name mà không có thì làm sao chạy thuật toán đc bấc
 

boyxin

Members actively
Tham gia ngày
10 Tháng ba 2008
Bài viết
1,666
Được thích
2,332
Điểm
860
Nơi ở
Hải Dương
Làm thử vầy. Hình như thuật toán này gọi là thuật toán vét cạn.
PHP:
Function SumF(Num As Double, ParamArray Args() As Variant) As String
Dim Data(), Cll As Range, n As Long, k As Long, Arr(), Total As Double
For i = LBound(Args) To UBound(Args)
    For Each Cll In Args(i)
        If Val(Cll.Value) <> 0 Then
            n = n + 1
            ReDim Preserve Data(1 To 2, 1 To n)
            Data(1, n) = Val(Cll.Value)
            Data(2, n) = Cll.Address(0, 0)
        End If
    Next
Next
ReDim Arr(1 To 1)
Arr(1) = 1
Total = Data(1, 1)
n = 1
k = 1
Do While Num <> Total
    If Arr(1) = UBound(Data, 2) Then
        SumF = "#N/A"
        Exit Function
    End If
    If Total > Num Then
        If k = UBound(Data, 2) Then
            k = Arr(n - 1) + 1
            Total = Total - Data(1, Arr(n)) - Data(1, Arr(n - 1)) + Data(1, k)
            n = n - 1
            Arr(n) = k
        Else
            k = k + 1
            Total = Total - Data(1, Arr(n)) + Data(1, k)
            Arr(n) = k
        End If
    Else
        If k = UBound(Data, 2) Then
            k = Arr(n - 1) + 1
            Total = Total - Data(1, Arr(n)) - Data(1, Arr(n - 1)) + Data(1, k)
            n = n - 1
            Arr(n) = k
        Else
            k = k + 1
            Total = Total + Data(1, k)
            n = n + 1
            ReDim Preserve Arr(1 To n)
            Arr(n) = k
        End If
    End If
Loop
For k = 1 To n
    SumF = SumF & "+" & Data(2, Arr(k))
Next
SumF = Replace(SumF, "+", "=", 1, 1)
End Function
CODE này chạy rất nhanh, nhẹ - thuật giải thật tuyệt vời - Cảm ơn huuthang_bd rất nhiều
Nhưng là Function mới chỉ cho ra 1 đáp án
XIN GIÚP: Giờ muốn chuyển thành Sub để liệt kê hết các đáp án (các hoán vị lệt kê 1 lần) thì sửa code này như nào ?
 
Top Bottom