Liệt kê 3 mã theo tổng.

[BinhTam]

Mình muốn tạo một hàm vba/udf như sau:
1. Nhập tổng 3 số ở cột F (từ cột CODi) của 3 maNPL không giống nhau trong bảng data ($B$3:$C$57).
vd: Sau khi nhập tổng 20.66666667= 3.333333333 + 10.66666667 + 2.666666667

2. Liệt kê 3 maNPL tìm thấy trong bảng data ($B$3:$C$57) ra.
vd: AE - GD - BK

và tìm 3 ma NPL tiếp theo có tổng cũng bằng như trên theo bảng dữ liệu cho sẵn.
vd: 20.66666667=6.666666667 + 2.000000000 + 12.000000000
=> RD RC ZA
Các bạn tìm file dữ liệu mẫu trong file đính kèm.

Đang tải Google Trang tính

Mong nhận tin từ các bạn.
Cảm ơn.

 

[HieuCD]

Mình muốn tạo một hàm vba/udf như sau:
1. Nhập tổng 3 số ở cột F (từ cột CODi) của 3 maNPL không giống nhau trong bảng data ($B$3:$C$57).
vd: Sau khi nhập tổng 20.66666667= 3.333333333 + 10.66666667 + 2.666666667

2. Liệt kê 3 maNPL tìm thấy trong bảng data ($B$3:$C$57) ra.
vd: AE - GD - BK

và tìm 3 ma NPL tiếp theo có tổng cũng bằng như trên theo bảng dữ liệu cho sẵn.
vd: 20.66666667=6.666666667 + 2.000000000 + 12.000000000
=> RD RC ZA
Các bạn tìm file dữ liệu mẫu trong file đính kèm.

Đang tải Google Trang tính

Mong nhận tin từ các bạn.
Cảm ơn.

Nhập tổng cần tìm vào ô F3, kết quả liệt kê tối đa N=100 kết quả thỏa điều kiện tổng = F3

Option Explicit
Sub XYZ()
  Dim sArr(), res(), sRow&, i&, i2&, i3&, t#, t2#, t3#, Tong#, k&
  Const e# = 10 ^ (-12) 'Sai so cho phep
  Const N& = 100 'So dong ket qua
 
  i = Range("B999999").End(xlUp).Row
  res = Range("B3:C" & i).Value
  Range("B3:C" & i).Sort Range("C3"), 1, Header:=xlNo
  sArr = Range("B3:C" & i).Value
  Range("B3:C" & i).Value = res
  ReDim res(1 To N, 1 To 3)
  Tong = Range("F3").Value 'Tong can tìm
  sRow = UBound(sArr)
 
  For i = 1 To sRow - 2
    t = sArr(i, 2)
    If t >= Tong Then Exit For
    For i2 = i + 1 To sRow - 1
      t2 = t + sArr(i2, 2)
      If t2 >= Tong Then Exit For
      For i3 = i2 + 1 To sRow 
        t3 = t2 + sArr(i3, 2)
        If t3 > Tong + e Then
          Exit For
        ElseIf t3 >= Tong - e Then
          k = k + 1
          res(k, 1) = sArr(i, 1)
          res(k, 2) = sArr(i2, 1)
          res(k, 3) = sArr(i3, 1)
          If k = N Then GoTo Ketqua
        End If
      Next i3
    Next i2
  Next i
Ketqua:
  Range("G3").Resize(N, 3) = res
End Sub

 

[BinhTam]

Chào HieuCD,
Thật tuyệt vời.
Cảm ơn HieuCD rất nhiều.
HieuCD cho mình hỏi thêm, nếu mình muốn áp dụng vba vào module của Microsoft Access thì mình cần chỉnh lại vba trên như thế nào?

 

[HieuCD]

Chào HieuCD,
Thật tuyệt vời.
Cảm ơn HieuCD rất nhiều.
HieuCD cho mình hỏi thêm, nếu mình muốn áp dụng vba vào module của Microsoft Access thì mình cần chỉnh lại vba trên như thế nào?

Mình chưa làm nên không rỏ, các bạn khác có thể biết

 

[BinhTam]

Mình chưa làm nên không rỏ, các bạn khác có thể biết

Bạn cho mình hỏi sRow - 2, sRow - 1, sRow - 2
những dòng này là gi? bạn có thể nói rõ thêm không?

 

[HieuCD]

Bạn cho mình hỏi sRow - 2, sRow - 1, sRow - 2
những dòng này là gi? bạn có thể nói rõ thêm không?

sRow là số dòng dữ liệu, lấy 3 mã phân biệt nên mỗi mã được chọn phải cách nhau ít nhất 1 dòng, 3 for sẽ lệch 1 dòng và dòng lớn nhất là sRow
Code mình bị nhầm tí đã chỉnh lại

for i =1 to sRow-2

for i2 =i+1 to sRow-1

for i3 =i2+1 to sRow

 

[BinhTam]

sRow là số dòng dữ liệu, lấy 3 mã phân biệt nên mỗi mã được chọn phải cách nhau ít nhất 1 dòng, 3 for sẽ lệch 1 dòng và dòng lớn nhất là sRow
Code mình bị nhầm tí đã chỉnh lại

for i =1 to sRow-2

for i2 =i+1 to sRow-1

for i3 =i2+1 to sRow

Cảm ơn bạn nhiều.