Chọn 2 số có tổng gần đúng nhất với số cho trước (trong VBA)

Liên hệ QC
DucanhNg

DucanhNg

Thành viên mới
Tham gia
26/3/20
Bài viết
7
Được thích
4
Em chào anh chị ạ,
Em có bài toán như sau ạ: Cho 1 bảng số liệu cho trước (i hàng, j cột) và 1 số thập phân ( 2 số sau dấu phẩy). Cần tìm ra 2 số trong bảng có tổng lớn hơn gần nhất với số đã cho ạ?
Em cũng nghĩ tới việc tính tổng 2 số bất kì rồi so sánh giá trị làm tròn của nó với giá trị làm tròn của số đã cho nhưng do khả năng có hạn nên chưa viết đc thuật toán ạ.
Em cũng đã tìm thử vài bài trên diễn đàn nhưng chỉ thấy bài tính tổng cho 2 trong dãy chứ trong bảng thì ko có ạ.
Mong mn giúp đỡ, em xin cảm ơn ạ
 
Bạn có thể cho biết các trị I & J khoảng là bi nhiêu không?
:D
 
DucanhNg đã viết:
Cho 1 bảng số liệu cho trước (i hàng, j cột) và 1 số thập phân ( 2 số sau dấu phẩy).
Cần tìm ra 2 số trong bảng có tổng lớn hơn gần nhất với số đã
Nhấp chuột vào đây để mở rộng...
Có bảng số liệu cho trước mới làm được.
Bạn có thể xem ở đây:

www.giaiphapexcel.com

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

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à...
www.giaiphapexcel.com www.giaiphapexcel.com
 
Bạn thử kiểm tra cách cù lần của mình xem sao:

(1) Tạo ra bảng số liệu ngẫu nhiên trên 1 trang tính trống:
Mã: 
 Sub TaoBangSoNgau5_11()
  Dim Dg As Long, Cot As Integer, Num As Double
  Randomize
  For Dg = 3 To 7
    For Cot = 2 To 12
        Num = ((1000 + 10 ^ 4 * Rnd()) \ 1) / 100
        Cells(Dg, Cot).Value = Num
    Next Cot
  Next Dg
  [G1].Value = Application.WorksheetFunction.Max([G3].CurrentRegion) + 35
  [G1].Interior.ColorIndex = 35 + 9 * Rnd() \ 1
  [G3].CurrentRegion.Interior.ColorIndex = 2
 End Sub

Sao đó chạy macro này trên bảng số liệu vừa được tạo ra:
PHP: 
 Sub TimTongGanNhat()
  Dim Cls As Range, WF As Object
  Dim Dg As Long, Cot As Integer, Rws As Long, Col As Integer, mRw As Long, mCol As Integer
  Dim Tong As Double, Min_ As Double, Tmp As Double, Num As Double
  
  Set WF = Application.WorksheetFunction:               Num = [G1].Value
  Min_ = WF.Max([G3].CurrentRegion):                       [G3].CurrentRegion.Interior.ColorIndex = 2
  For Each Cls In [G3].CurrentRegion
    For Dg = 3 To 7
        For Cot = 2 To 12
            If Dg <> Cls.Row And Cot <> Cls.Column Then
                Tong = Cls.Value + Cells(Dg, Cot).Value
                If Tong > Num Then
                    Tmp = Tong - Num
                    If Tmp < Min_ Then
                        Rws = Cls.Row:                      Col = Cls.Column
                        mRw = Dg:                               mCol = Cot
                        Min_ = Tmp
                    End If
                End If
            End If
        Next Cot
    Next Dg
 Next Cls
 Cells(Rws, Col).Interior.ColorIndex = 38
 Cells(mRw, mCol).Interior.ColorIndex = 41
 End Sub
 
phuocam đã viết:
Có bảng số liệu cho trước mới làm được.
Bạn có thể xem ở đây:

www.giaiphapexcel.com

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

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à...
www.giaiphapexcel.com www.giaiphapexcel.com
Nhấp chuột vào đây để mở rộng...
Em đọc bài này rồi ạ. Mà tại vì bài kia chỉ có theo 1 dãy còn của em là trong 1 bảng ( có cả hàng và cột) nên em ko áp dụng đc ạ.
Bài đã được tự động gộp:

SA_DQ đã viết:
Bạn thử kiểm tra cách cù lần của mình xem sao:

(1) Tạo ra bảng số liệu ngẫu nhiên trên 1 trang tính trống:
Mã: 
Sub TaoBangSoNgau5_11()
  Dim Dg As Long, Cot As Integer, Num As Double
  Randomize
  For Dg = 3 To 7
    For Cot = 2 To 12
        Num = ((1000 + 10 ^ 4 * Rnd()) \ 1) / 100
        Cells(Dg, Cot).Value = Num
    Next Cot
  Next Dg
  [G1].Value = Application.WorksheetFunction.Max([G3].CurrentRegion) + 35
  [G1].Interior.ColorIndex = 35 + 9 * Rnd() \ 1
  [G3].CurrentRegion.Interior.ColorIndex = 2
End Sub

Sao đó chạy macro này trên bảng số liệu vừa được tạo ra:
PHP: 
Sub TimTongGanNhat()
  Dim Cls As Range, WF As Object
  Dim Dg As Long, Cot As Integer, Rws As Long, Col As Integer, mRw As Long, mCol As Integer
  Dim Tong As Double, Min_ As Double, Tmp As Double, Num As Double
 
  Set WF = Application.WorksheetFunction:               Num = [G1].Value
  Min_ = WF.Max([G3].CurrentRegion):                       [G3].CurrentRegion.Interior.ColorIndex = 2
  For Each Cls In [G3].CurrentRegion
    For Dg = 3 To 7
        For Cot = 2 To 12
            If Dg <> Cls.Row And Cot <> Cls.Column Then
                Tong = Cls.Value + Cells(Dg, Cot).Value
                If Tong > Num Then
                    Tmp = Tong - Num
                    If Tmp < Min_ Then
                        Rws = Cls.Row:                      Col = Cls.Column
                        mRw = Dg:                               mCol = Cot
                        Min_ = Tmp
                    End If
                End If
            End If
        Next Cot
    Next Dg
Next Cls
Cells(Rws, Col).Interior.ColorIndex = 38
Cells(mRw, mCol).Interior.ColorIndex = 41
End Sub
Nhấp chuột vào đây để mở rộng...
dạ em cảm ơn ạ. Áp 2 bản của anh vào thì nó chạy mượt nhưng tách ra thì lại bị lỗi. Em đang xem xem áp dụng vào bài riêng của em ntn được ạ. Em cảm ơn nhiều ạ.
 
Lần chỉnh sửa cuối:
DucanhNg đã viết:
Em đọc bài này rồi ạ. Mà tại vì bài kia chỉ có theo 1 dãy còn của em là trong 1 bảng ( có cả hàng và cột) nên em ko áp dụng đc ạ.
Nhấp chuột vào đây để mở rộng...
Thì "sắp xếp" các phần tử của mảng r x c (r dòng, c cột) thành dãy đi.

Giả sử ta gán cho các phần tử lần lượt của cột 1 các số 1, 2, ..., r, các phần tử lần lượt của cột 2 các số r+1, r+2, ..., r+r, ..., các phần tử lần lượt của cột c các số (c-1)r+1, (c-1)r+2, ..., (c-1)r+r

Như thế thì phần tử thứ k của dãy, với k = 1, 2, ..., r*c, là phần tử của mảng ở:
- dong = ((k-1) mod r)+1
- cot = (k-dong)/r+1

Ta có ánh xạ 1 <-> 1: mảng <-> dãy.

Lúc này cần xét các tổng (cách cần cù, xét từng trường hợp, chưa nghĩ cách tối ưu):
thứ 1 + thứ 2, thứ 1 + thứ 3, ..., thứ 1 + thứ r*c,
thứ 2 + thứ 3, thứ 2 + thứ 4, ..., thứ 2 + thứ r*c
...
thứ r*c-1 + thứ r*c

Tức:
Mã: 
For k = 1 to r*c-1
    For n = k+1 to r*c      
        tong_hien_hanh = mang(((k-1) mod r)+1, (k-(k-dong)/r+1)/r+1)+mang(((n-1) mod r)+1, (n-(n-dong)/r+1)/r+1)
        ...
    Next n
Next k
Tôi viết trong notepad và tính nhẩm trong đầu vào 2:00 đêm (mắt cứ díp lại) nên có thể có sai sót. Cũng do 2:00 đêm nên có thể hướng đi chưa tối ưu. Chỉ là minh họa.
dạ em cảm ơn ạ. Áp 2 bản của anh vào thì nó chạy mượt nhưng tách ra thì lại bị lỗi.
Nhấp chuột vào đây để mở rộng...
Mượt?
Với dữ liệu ví dự như trong hình thì code chạy có lỗi (vì không có kết quả) tại 2 dòng
Mã: 
Cells(Rws, Col).Interior.ColorIndex = 38
Cells(mRw, mCol).Interior.ColorIndex = 41
Do Rws, Col, mRw, mCol đều = 0 - Cụm If Tong > Num Then ... End If không bao giờ được thực hiện.
Nhưng rõ ràng với dữ liệu như thế thì có kết quả. Nếu là tìm gần nhất >= 100 thì kết quả là 100. Nếu là tìm gần nhất > 100 thì kết quả là 101.

tong.JPG
 
Lần chỉnh sửa cuối:
batman1 đã viết:
Thì "sắp xếp" các phần tử của mảng r x c (r dòng, c cột) thành dãy đi.

Giả sử ta gán cho các phần tử lần lượt của cột 1 các số 1, 2, ..., r, các phần tử lần lượt của cột 2 các số r+1, r+2, ..., r+r, ..., các phần tử lần lượt của cột c các số (c-1)r+1, (c-1)r+2, ..., (c-1)r+r

Như thế thì phần tử thứ k của dãy, với k = 1, 2, ..., r*c, là phần tử của mảng ở:
- dong = ((k-1) mod r)+1
- cot = (k-dong)/r+1

Ta có ánh xạ 1 <-> 1: mảng <-> dãy.

Lúc này cần xét các tổng (cách cần cù, xét từng trường hợp, chưa nghĩ cách tối ưu):
thứ 1 + thứ 2, thứ 1 + thứ 3, ..., thứ 1 + thứ r*c,
thứ 2 + thứ 3, thứ 2 + thứ 4, ..., thứ 2 + thứ r*c
...
thứ r*c-1 + thứ r*c

Tức:
Mã: 
For k = 1 to r*c-1
    For n = k+1 to r*c    
        tong_hien_hanh = mang(((k-1) mod r)+1, (k-(k-dong)/r+1)/r+1)+mang(((n-1) mod r)+1, (n-(n-dong)/r+1)/r+1)
        ...
    Next n
Next k
Tôi viết trong notepad và tính nhẩm trong đầu vào 2:00 đêm (mắt cứ díp lại) nên có thể có sai sót. Cũng do 2:00 đêm nên có thể hướng đi chưa tối ưu. Chỉ là minh họa.

Mượt?
Với dữ liệu ví dự như trong hình thì code chạy có lỗi (vì không có kết quả) tại 2 dòng
Mã: 
Cells(Rws, Col).Interior.ColorIndex = 38
Cells(mRw, mCol).Interior.ColorIndex = 41
Do Rws, Col, mRw, mCol đều = 0 - Cụm If Tong > Num Then ... End If không bao giờ được thực hiện.
Nhưng rõ ràng với dữ liệu như thế thì có kết quả. Nếu là tìm gần nhất >= 100 thì kết quả là 100. Nếu là tìm gần nhất > 100 thì kết quả là 101.

View attachment 234046
Nhấp chuột vào đây để mở rộng...
Dạ anh cũng đang ở Pháp (hoặc 1 nc châu âu) ạ?
Em cũng mới học cái này trên trường mà các thầy bên này để tự bơi nên em cũng chưa hiểu lắm ạ.
Em cũng mới thử qua vài giá trị theo code của anh kia nên tạm chưa có lỗi ạ. Bt của em thì nó la
 
Bt của em như này ạ. Cho trước bảng diện tích cốt thép (viết code để cho ra bảng như trong excel).
Cho trước diện tích cốt thép As đã được tính toán. Yêu cầu: tìm số lượng thanh thép phù hợp với diện tích cốt thép As đã cho, xuất ra nhiều kết quả thỏa mãn.
Phù hợp ở đây là những thanh thép phải có diện tích gần sát với số As đã cho. Có thể có nhiều hơn 2 loại thép ( khác phi, khác số lượng).
Bài đã được tự động gộp:

batman1 đã viết:
Tôi ở Ba Lan. Mà tôi đi ngủ đây.
Nhấp chuột vào đây để mở rộng...
Dạ chúc anh ngủ ngon ạ. Em cảm ơn ạ.
 

File đính kèm

  • bang thep.xlsm
    19.6 KB · Đọc: 7
Theo quy tắc chung của nói chuyện giải quyết vấn đề thì tránh dùng từ viết tắt. "Bài tập" thì ghi rõ là "bài tập", chớ có lười biếng gõ "bt".
Lý do rất đơn giản là người giải bài phải tập trung 100% trí óc để suy nghĩ vấn đề, tách ra phần trăm nào để suy nghĩ đoán từ viết tắt là mất oan uổng phần trăm ấy. Bạn thấy là chịu khó viết đàng hoàng chỉ có lợi cho mình thôi.

Cách dễ nhất để giải bài toán cặp đôi là sắp xếp tất cả các số lại thành dãy (mảng) tăng dần. Rồi:
- chọn số đầu tiên
- lấy hiệu số giữa số này và tổng.
- rà dãy số, tìm số gần nhất với tổng này. Lưu ý là mảng tăng dần cho nên rà theo nhị phân rất nhanh.
- chọn số kế tiếp và lặp lại
- so sánh và chọn cặp tối ưu. Nếu cặp nào đúng chính xác luôn thì khỏi lặp lại nữa.
 
VetMini đã viết:
Theo quy tắc chung của nói chuyện giải quyết vấn đề thì tránh dùng từ viết tắt. "Bài tập" thì ghi rõ là "bài tập", chớ có lười biếng gõ "bt".
Lý do rất đơn giản là người giải bài phải tập trung 100% trí óc để suy nghĩ vấn đề, tách ra phần trăm nào để suy nghĩ đoán từ viết tắt là mất oan uổng phần trăm ấy. Bạn thấy là chịu khó viết đàng hoàng chỉ có lợi cho mình thôi.

Cách dễ nhất để giải bài toán cặp đôi là sắp xếp tất cả các số lại thành dãy (mảng) tăng dần. Rồi:
- chọn số đầu tiên
- lấy hiệu số giữa số này và tổng.
- rà dãy số, tìm số gần nhất với tổng này. Lưu ý là mảng tăng dần cho nên rà theo nhị phân rất nhanh.
- chọn số kế tiếp và lặp lại
- so sánh và chọn cặp tối ưu. Nếu cặp nào đúng chính xác luôn thì khỏi lặp lại nữa.
Nhấp chuột vào đây để mở rộng...
Dạ. Em sẽ chú ý ạ. Cảm ơn anh đã nhắc nhở ạ.
 
Ví dụ số cần tìm là 16.08 bạn muốn xuất ra 2 kết quả là:

1. Phi: 32, số thanh: 2

2. Phi: 16, số thanh: 8

Nếu vậy, tìm chính xác được 1 cặp rồi vẫn tìm tiếp.
 
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

H
Nhờ hướng dẫn chuyển hàng thành cột và dữ liệu theo nhu cầu bằng VBA
Trả lời
1
Đọc
47
DeTong
D
H
  • Question
Code VBA cho kết quả dòng, cột theo điều kiện từ 2 Sheets
Trả lời
2
Đọc
71
SA_DQ
SA_DQ
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
2
Đọc
61
NguyenthiH
NguyenthiH
T
Cần giúp sao chép C1 từ B1
Trả lời
3
Đọc
82
tle2003
T
A
Tìm số nhỏ nhất, số lớn nhất theo ngày
Trả lời
6
Đọc
76
hoangtuaotrang_hp_vn
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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