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

[minhdangdlk]

Mình đang gặp phải một vấn đề là:
Trong bảng excel mình cần tìm tất cả các ô có tổng bằng với một số cho trước. các ô nằm cùng trên một cột. Mình đã viết một đoạn chương trình như sau :
Function Tim(So, A As Range) As String
On Error Resume Next
Dim i, j, k As Integer
Dim Tong As Long
Dim s As String

n = A.Rows.Count - 1
For i = 2 To n
For j = i To n '- i
Tong = 0
s = ""
For k = 1 To i - 1
Tong = Tong + A(k - 1 + j)
s = s & IIf(s = "", "A", "+A") & k - 1 + j
Next
For k = j + i - 1 To n
If Tong + A(k) = So Then
'In ra man hinh
Tim = Tim & s & IIf(s = "", "A", "+A") & k & ";"
End If
Next
Next
Next
End Function
Chương trình chỉ thực hiện được nếu có các ô đầu nằm liên tiếp nhau. nhưng không thể tìm được các ô cách nhau.
Nhờ các bạn chỉ giùm mình khắc để khắc phục việc có thể tìm được các ô cách nhau với. cám ơn các bạn.

 

[ndu96081631]

Mình đang gặp phải một vấn đề là:
Trong bảng excel mình cần tìm tất cả các ô có tổng bằng với một số cho trước. các ô nằm cùng trên một cột. Mình đã viết một đoạn chương trình như sau :
Function Tim(So, A As Range) As String
On Error Resume Next
Dim i, j, k As Integer
Dim Tong As Long
Dim s As String

n = A.Rows.Count - 1
For i = 2 To n
For j = i To n '- i
Tong = 0
s = ""
For k = 1 To i - 1
Tong = Tong + A(k - 1 + j)
s = s & IIf(s = "", "A", "+A") & k - 1 + j
Next
For k = j + i - 1 To n
If Tong + A(k) = So Then
'In ra man hinh
Tim = Tim & s & IIf(s = "", "A", "+A") & k & ";"
End If
Next
Next
Next
End Function
Chương trình chỉ thực hiện được nếu có các ô đầu nằm liên tiếp nhau. nhưng không thể tìm được các ô cách nhau.
Nhờ các bạn chỉ giùm mình khắc để khắc phục việc có thể tìm được các ô cách nhau với. cám ơn các bạn.

Tôi nghĩ bài của bạn nên dùng Solver thì đúng hơn. Xem bài này:
http://www.giaiphapexcel.com/forum/showthread.php?34932-Cần-lọc-danh-sách-khách-hàng

 

[minhdangdlk]

Cảm ơn bạn ndu96081631 đã hướng dẫn. nhưng với các sử dụng solver thì chỉ liệt kê ra những ô có giá trị tham gia vào tính tổng sẽ bằng giá trị cho trước thôi. ở đây tôi muốn sẽ hiển thị lên màn hình cụ thể những ô nào cộng lại thì bằng giá trị cho trước ví dụ như : A2+A7; A3+A5+A1.... là những dãy ô có tổng đúng bằng giá trị cho trước. Rất mong được sự góp ý của các bạn. xin cám ơn.

 

[ndu96081631]

Cảm ơn bạn ndu96081631 đã hướng dẫn. nhưng với các sử dụng solver thì chỉ liệt kê ra những ô có giá trị tham gia vào tính tổng sẽ bằng giá trị cho trước thôi. ở đây tôi muốn sẽ hiển thị lên màn hình cụ thể những ô nào cộng lại thì bằng giá trị cho trước ví dụ như : A2+A7; A3+A5+A1.... là những dãy ô có tổng đúng bằng giá trị cho trước. Rất mong được sự góp ý của các bạn. xin cám ơn.

Solver đã ra kết quả rồi ---> Phần còn lại bạn muốn thế nào mà chẳng được chứ ---> Suy nghĩ thêm đi
Dùng vòng lập e rằng không ăn thua vì bài toán rất có thể ra vô số nghiệm --> For đến bao giờ mới xong!

 

[ChanhTQ@]

Bạn tham khảo sơ bộ macro củ chuối này lúc rỗi

cỡ 30 fút gì đó,nha:

Option Explicit
[B]Sub TimSoNgau()[/B]
 Dim Num As Integer, jJ As Integer, Tong, Zz As Integer
 Dim Cls As Range, Rng As Range, sRng As Range
 
 [B1].FormulaR1C1 = "Rand"
 [B2].Resize(65500).Clear
 Randomize:          Num = 90 + Int(9 * Rnd())
 [B2].Value = 1 + Int(9 * Rnd())
 For jJ = 3 To Num
   Cells(jJ, "B").Value = Cells(jJ - 1, "B").Value + 1 + Int(9 * Rnd())
 Next jJ
 With Cells(Num, "B")
   Tong = .Value + .Value \ 2
 End With
 
 Set Rng = Range([B2], [B2].End(xlDown))
 [C1].Value = Tong
 For Each Cls In Rng
   For jJ = Num To 2 Step -1
      For Zz = [B2].Value To Cells(Num, "B").Value
         Set sRng = Rng.Find(jJ, , xlFormulas, xlWhole)
         If Not sRng Is Nothing Then
            If Cls.Value + Cells(jJ, "B") + Zz = Tong Then
               [D65500].End(xlUp).Offset(1).Value = Str(Cls.Value) & _
                  Str(Cells(jJ, 2).Value) & Str(Zz)
            End If
         End If
      Next Zz
   Next jJ
 Next Cls
[B]End Sub[/B]

 

[mainga_hg]

Bạn tham khảo sơ bộ macro củ chuối này lúc rỗi

cỡ 30 fút gì đó,nha:

Option Explicit
[B]Sub TimSoNgau()[/B]
 Dim Num As Integer, jJ As Integer, Tong, Zz As Integer
 Dim Cls As Range, Rng As Range, sRng As Range
 
 [B1].FormulaR1C1 = "Rand"
 [B2].Resize(65500).Clear
 Randomize:          Num = 90 + Int(9 * Rnd())
 [B2].Value = 1 + Int(9 * Rnd())
 For jJ = 3 To Num
   Cells(jJ, "B").Value = Cells(jJ - 1, "B").Value + 1 + Int(9 * Rnd())
 Next jJ
 With Cells(Num, "B")
   Tong = .Value + .Value \ 2
 End With
 
 Set Rng = Range([B2], [B2].End(xlDown))
 [C1].Value = Tong
 For Each Cls In Rng
   For jJ = Num To 2 Step -1
      For Zz = [B2].Value To Cells(Num, "B").Value
         Set sRng = Rng.Find(jJ, , xlFormulas, xlWhole)
         If Not sRng Is Nothing Then
            If Cls.Value + Cells(jJ, "B") + Zz = Tong Then
               [D65500].End(xlUp).Offset(1).Value = Str(Cls.Value) & _
                  Str(Cells(jJ, 2).Value) & Str(Zz)
            End If
         End If
      Next Zz
   Next jJ
 Next Cls
[B]End Sub[/B]

Cái code này là lafmg ì vậy bạn mình chạy thử mà ko hiểu luôn?