Chọn dãy số sao cho tổng dãy số đó gần bằng nhất với số cho trước. (3 người xem)

[thufpts]

Em chào các bác. em có bài toán này nhưng với khả năng của em không giải quyết được.
Em có một dãy số bất kỳ tại cột G. khi em nhập một giá trị bất kì tại ô màu đỏ ví dụ là 60
thì tại cột H nó sẽ tự động lấy giá trị ở cột G từ trên xuông (bắt buộc) sao cho tổng
ở vùng màu vàng của côt H phải thỏa mãn 1 trong các điều kiện sau
1. bằng ô màu đỏ tại cột H
2. lớn hơn ô màu đỏ tại cột H với giá trị gần nhất ví dụ 61 (tùy vào tổng của vùng màu vàng)
3. nhỏ hơn ô màu đỏ tại cột H với giá trị gần nhất ví dụ 59 (tùy vào tổng của vùng màu vàng).
Mỗi khi giá trị ở cột G thay đổi thì giá trị của vùng màu vàng tại cột H sẽ thay đổi theo.
tương tự khi nhập giá trị bất kì cho các cột I,J,K,L,M
Em rất mong các bác cao thủ giúp em với. em cám ơn các bác nhiều lắm.

 

[thufpts]

Vẫn có trường hợp chưa đúng

em tìm mãi mới thấy cái này nghĩa là cách tính tổng có vấn đề. em thử thêm vào vài con số khác thì nó ra kết quả này.
có cách nào với trường hợp này nó sẽ chia con số 600 kia ra đẩy sang cột J, để tổng gần nhất với số cho trước là 500 không

 

[befaint]

em tìm mãi mới thấy cái này nghĩa là cách tính tổng có vấn đề. em thử thêm vào vài con số khác thì nó ra kết quả này.
có cách nào với trường hợp này nó sẽ chia con số 600 kia ra đẩy sang cột J, để tổng gần nhất với số cho trước là 500 không

View attachment 167661

Trường hợp bạn nêu là do dữ liệu cột G khác với file bài #1 (cái tội giả lập dữ liệu không khớp với dữ liệu thật, quy luật sẽ khác nhau). Cái này khác với cái tôi phát hiện.
Mà sửa code thì tìm chủ nhân nhá. Tôi không được phép.

 

[thufpts]

vâng cảm ơn bác rất nhiều. nói đúng ra thì em không tính toán được hết. chỉ là khi em nhập nó mới phát sinh vấn đề bác ạ.

 

[huuthang_bd]

em tìm mãi mới thấy cái này nghĩa là cách tính tổng có vấn đề. em thử thêm vào vài con số khác thì nó ra kết quả này.
có cách nào với trường hợp này nó sẽ chia con số 600 kia ra đẩy sang cột J, để tổng gần nhất với số cho trước là 500 không

View attachment 167661

Hình này vẫn đúng với các điều kiện mà bạn đưa ra

 

[thufpts]

Hình này vẫn đúng với các điều kiện mà bạn đưa ra

Ôi em hay bị tâm lý vì em thấy bác kia bao vẫn có chỗ chưa đúng hihihi nên em hỏi lại.
Em muốn nhờ các bác thêm 1 vấn đề nữa. em định post bài khác nhưng em nghĩ nó cùng 1 vấn đề.
Cũng với cách tính tổng này nhưng nó sẽ tính đúng với số tổng đã cho trước.
nghĩa là nếu tổng các giá trị lấy ra mà lớn hơn số tổng đã cho trước thì số tổng ban đầu phải trừ đi giá
trị cuối cùng trong dãy N đơn vị để tổng được tính bằng đúng với số tổng ban đầu.
số bị trừ sẽ được chuyển sang cột bên cạnh để cộng với các giá trị khác.

Ví dụ cụ thể em đã nhập lại số trong file mà các bác đã giúp em. em gửi lại để các bác xem.
Rất mong các bác giúp em.

 

[thufpts]

do không đọc yêu cầu của bạn nên hiểu nhầm, bạn sửa lại code sub GPE

Sub GPE()
Dim i As Long, t1 As Long, t2 As Long, dk As Long
Dim LastR As Long, LastC As Integer, Darr(), Sarr(), Arr()
LastR = Sheet1.Range("G65000").End(xlUp).Row
Darr = Sheet1.Range("G4:G" & LastR + 1).Value
Sarr = Sheet1.Range("H2:M2").Value
LastC = UBound(Sarr, 2)
ReDim Arr(1 To UBound(Darr), 1 To LastC + 1)
Range("H4:M" & LastR).ClearContents
For j = 1 To LastC
    If Sarr(1, j) > 0 Then
    dk = Sarr(1, j)
    t1 = 0
    For i = 1 To UBound(Darr) - 1
        If Arr(i, LastC + 1) <> 123 Then
            t1 = t1 + Darr(i, 1)
            If t1 - Darr(i, 1) / 2 <= dk Then
                Arr(i, j) = Darr(i, 1): Arr(i, LastC + 1) = 123
            End If
        End If
    Next i
    End If
Next j
Sheet1.Range("H4").Resize(UBound(Arr) - 1, UBound(Arr, 2) - 1) = Arr
End Sub

Em muốn nhờ các bác thêm 1 vấn đề nữa. em định post bài khác nhưng em nghĩ nó cùng 1 vấn đề.
Cũng với cách tính tổng này nhưng nó sẽ tính đúng với số tổng đã cho trước.
nghĩa là nếu tổng các giá trị lấy ra mà lớn hơn số tổng đã cho trước thì số tổng ban đầu phải trừ đi giá
trị cuối cùng trong dãy N đơn vị để tổng được tính bằng đúng với số tổng ban đầu.
số bị trừ sẽ được chuyển sang cột bên cạnh để cộng với các giá trị khác. em diễn tả hơi ngu tí
vì em không có logic
Ví dụ cụ thể em đã nhập lại số trong file mà các bác đã giúp em. em gửi lại để các bác xem.
Rất mong các bác giúp em.

 

[befaint]

Ôi em hay bị tâm lý vì em thấy bác kia bao vẫn có chỗ chưa đúng hihihi nên em hỏi lại.
Em muốn nhờ các bác thêm 1 vấn đề nữa. em định post bài khác nhưng em nghĩ nó cùng 1 vấn đề.
...

Tôi không có nói chơi.

 

[thufpts]

Tôi không có nói chơi.

Bác đừng tức giận. em nói thật là em không biết cái gì cả nên khi bác nói em sẽ tin.
vì mọi người đã giúp đỡ rất nhiệt tình. mong bác thông cảm

 

[befaint]

Bác đừng tức giận. em nói thật là em không biết cái gì cả nên khi bác nói em sẽ tin.
vì mọi người đã giúp đỡ rất nhiệt tình. mong bác thông cảm

Ây dza. Đó là một câu khẳng định.
Nếu có gì không thích thì mình nghỉ chơi thôi.
p/s: Tôi chờ bạn kiểm tra các trường hợp của bạn, nếu nó không xảy ra lỗi đó thì cũng không cần thiết chỉnh lại. Thực tế mà không xảy ra thì bỏ qua thôi.

 

[thufpts]

Ây dza. Đó là một câu khẳng định.
Nếu có gì không thích thì mình nghỉ chơi thôi.
p/s: Tôi chờ bạn kiểm tra các trường hợp của bạn, nếu nó không xảy ra lỗi đó thì cũng không cần thiết chỉnh lại. Thực tế mà không xảy ra thì bỏ qua thôi.

em thấy chạy ổn bác ạ. chỉ là em nhờ các bác thêm 1 trường hợp tính tổng đúng với số cho trước em vừa nêu trên thôi
em mong các bác giúp em.

 

[HieuCD]

Em muốn nhờ các bác thêm 1 vấn đề nữa. em định post bài khác nhưng em nghĩ nó cùng 1 vấn đề.
Cũng với cách tính tổng này nhưng nó sẽ tính đúng với số tổng đã cho trước.
nghĩa là nếu tổng các giá trị lấy ra mà lớn hơn số tổng đã cho trước thì số tổng ban đầu phải trừ đi giá
trị cuối cùng trong dãy N đơn vị để tổng được tính bằng đúng với số tổng ban đầu.
số bị trừ sẽ được chuyển sang cột bên cạnh để cộng với các giá trị khác. em diễn tả hơi ngu tí
vì em không có logic
Ví dụ cụ thể em đã nhập lại số trong file mà các bác đã giúp em. em gửi lại để các bác xem.
Rất mong các bác giúp em.

bạn chạy code thử

Sub GPE()
Dim i As Long, t1 As Long, t2 As Long, dk As Long
Dim LastR As Long, LastC As Integer, Darr(), Sarr(), Arr()
LastR = Sheet1.Range("G65000").End(xlUp).Row
Darr = Sheet1.Range("G4:G" & LastR + 1).Value
Sarr = Sheet1.Range("H2:M2").Value
LastC = UBound(Sarr, 2)
ReDim Arr(1 To UBound(Darr), 1 To LastC + 1)
Range("H4:M" & LastR).ClearContents
For j = 1 To LastC
    If Sarr(1, j) > 0 Then
        dk = Sarr(1, j)
        t1 = 0
        For i = 1 To UBound(Darr) - 1
            If Arr(i, LastC + 1) <> 123 Then
                t1 = t1 + Darr(i, 1)
                If t1 <= dk Then
                    Arr(i, j) = Darr(i, 1)
                    Arr(i, LastC + 1) = 123
                    If t1 = dk Then Exit For
                Else
                    Arr(i, j) = Sarr(1, j) + Darr(i, 1) - t1
                    Darr(i, 1) = Darr(i, 1) - Arr(i, j)
                    Exit For
                End If
            End If
        Next i
    End If
Next j
Sheet1.Range("H4").Resize(UBound(Arr) - 1, UBound(Arr, 2) - 1) = Arr
End Sub

 

[thufpts]

bạn chạy code thử

Sub GPE()
Dim i As Long, t1 As Long, t2 As Long, dk As Long
Dim LastR As Long, LastC As Integer, Darr(), Sarr(), Arr()
LastR = Sheet1.Range("G65000").End(xlUp).Row
Darr = Sheet1.Range("G4:G" & LastR + 1).Value
Sarr = Sheet1.Range("H2:M2").Value
LastC = UBound(Sarr, 2)
ReDim Arr(1 To UBound(Darr), 1 To LastC + 1)
Range("H4:M" & LastR).ClearContents
For j = 1 To LastC
    If Sarr(1, j) > 0 Then
        dk = Sarr(1, j)
        t1 = 0
        For i = 1 To UBound(Darr) - 1
            If Arr(i, LastC + 1) <> 123 Then
                t1 = t1 + Darr(i, 1)
                If t1 <= dk Then
                    Arr(i, j) = Darr(i, 1)
                    Arr(i, LastC + 1) = 123
                    If t1 = dk Then Exit For
                Else
                    Arr(i, j) = Sarr(1, j) + Darr(i, 1) - t1
                    Darr(i, 1) = Darr(i, 1) - Arr(i, j)
                    Exit For
                End If
            End If
        Next i
    End If
Next j
Sheet1.Range("H4").Resize(UBound(Arr) - 1, UBound(Arr, 2) - 1) = Arr
End Sub

bác giỏi quá. bái phục luôn. quá chuẩn, tuyệt vời

 

[thufpts]

bạn chạy code thử

Sub GPE()
Dim i As Long, t1 As Long, t2 As Long, dk As Long
Dim LastR As Long, LastC As Integer, Darr(), Sarr(), Arr()
LastR = Sheet1.Range("G65000").End(xlUp).Row
Darr = Sheet1.Range("G4:G" & LastR + 1).Value
Sarr = Sheet1.Range("H2:M2").Value
LastC = UBound(Sarr, 2)
ReDim Arr(1 To UBound(Darr), 1 To LastC + 1)
Range("H4:M" & LastR).ClearContents
For j = 1 To LastC
    If Sarr(1, j) > 0 Then
        dk = Sarr(1, j)
        t1 = 0
        For i = 1 To UBound(Darr) - 1
            If Arr(i, LastC + 1) <> 123 Then
                t1 = t1 + Darr(i, 1)
                If t1 <= dk Then
                    Arr(i, j) = Darr(i, 1)
                    Arr(i, LastC + 1) = 123
                    If t1 = dk Then Exit For
                Else
                    Arr(i, j) = Sarr(1, j) + Darr(i, 1) - t1
                    Darr(i, 1) = Darr(i, 1) - Arr(i, j)
                    Exit For
                End If
            End If
        Next i
    End If
Next j
Sheet1.Range("H4").Resize(UBound(Arr) - 1, UBound(Arr, 2) - 1) = Arr
End Sub

Bác ơi nếu em muốn tùy chọn các cột để nhập số tổng bất kỳ ví dụ H2, K2, M2 .... thì làm thế nào vậy bác

 

[HieuCD]

Bác ơi nếu em muốn tùy chọn các cột để nhập số tổng bất kỳ ví dụ H2, K2, M2 .... thì làm thế nào vậy bác

code cho phép nhập số tổng vào H2...M2, bạn nhập thử, nếu có vấn đề thì báo cụ thể, mình sẽ kiểm tra lại

 

[thufpts]

code cho phép nhập số tổng vào H2...M2, bạn nhập thử, nếu có vấn đề thì báo cụ thể, mình sẽ kiểm tra lại

Vâng code của bác quá tuyệt rồi.
ý em là em chỉ muốn thiết lập thêm tùy chọn cho các cột nhập số tổng
nghĩa là chỉ những cột nào được thiết lập thì mới tính tổng,
cột không được thiết lập số tổng cho trước nếu có nhập giá trị thì cũng sẽ không được tính tổng.
vị dụ như Cột J như hình bên dưới.

 

[HieuCD]

Vâng code của bác quá tuyệt rồi.
ý em là em chỉ muốn thiết lập thêm tùy chọn cho các cột nhập số tổng
nghĩa là chỉ những cột nào được thiết lập thì mới tính tổng,
cột không được thiết lập số tổng cho trước nếu có nhập giá trị thì cũng sẽ không được tính tổng.
vị dụ như Cột J như hình bên dưới.

không chạy code cột J? nếu vậy phải có nơi ghi nhận điều kiện như dòng 3 nhập Ok mới chạy cột nầy?

Sub GPE()
Dim i As Long, t1 As Long, t2 As Long, dk As Long
Dim LastR As Long, LastC As Integer, Darr(), Sarr(), Arr()
LastR = Sheet1.Range("G65000").End(xlUp).Row
Darr = Sheet1.Range("G4:G" & LastR + 1).Value
[COLOR=#ff0000]Sarr = Sheet1.Range("H2:M3").Value[/COLOR]
LastC = UBound(Sarr, 2)
ReDim Arr(1 To UBound(Darr), 1 To LastC + 1)
Range("H4:M" & LastR).ClearContents
For j = 1 To LastC
[COLOR=#ff0000]    If Sarr(1, j) > 0 And Sarr(2, j) = "Ok" Then[/COLOR]
        dk = Sarr(1, j)
        t1 = 0
        For i = 1 To UBound(Darr) - 1
            If Arr(i, LastC + 1) <> 123 Then
                t1 = t1 + Darr(i, 1)
                If t1 <= dk Then
                    Arr(i, j) = Darr(i, 1)
                    Arr(i, LastC + 1) = 123
                    If t1 = dk Then Exit For
                Else
                    Arr(i, j) = Sarr(1, j) + Darr(i, 1) - t1
                    Darr(i, 1) = Darr(i, 1) - Arr(i, j)
                    Exit For
                End If
            End If
        Next i
    End If
Next j
Sheet1.Range("H4").Resize(UBound(Arr) - 1, UBound(Arr, 2) - 1) = Arr
End Sub

 

[thufpts]

không chạy code cột J? nếu vậy phải có nơi ghi nhận điều kiện như dòng 3 nhập Ok mới chạy cột nầy?

Sub GPE()
Dim i As Long, t1 As Long, t2 As Long, dk As Long
Dim LastR As Long, LastC As Integer, Darr(), Sarr(), Arr()
LastR = Sheet1.Range("G65000").End(xlUp).Row
Darr = Sheet1.Range("G4:G" & LastR + 1).Value
[COLOR=#ff0000]Sarr = Sheet1.Range("H2:M3").Value[/COLOR]
LastC = UBound(Sarr, 2)
ReDim Arr(1 To UBound(Darr), 1 To LastC + 1)
Range("H4:M" & LastR).ClearContents
For j = 1 To LastC
[COLOR=#ff0000]    If Sarr(1, j) > 0 And Sarr(2, j) = "Ok" Then[/COLOR]
        dk = Sarr(1, j)
        t1 = 0
        For i = 1 To UBound(Darr) - 1
            If Arr(i, LastC + 1) <> 123 Then
                t1 = t1 + Darr(i, 1)
                If t1 <= dk Then
                    Arr(i, j) = Darr(i, 1)
                    Arr(i, LastC + 1) = 123
                    If t1 = dk Then Exit For
                Else
                    Arr(i, j) = Sarr(1, j) + Darr(i, 1) - t1
                    Darr(i, 1) = Darr(i, 1) - Arr(i, j)
                    Exit For
                End If
            End If
        Next i
    End If
Next j
Sheet1.Range("H4").Resize(UBound(Arr) - 1, UBound(Arr, 2) - 1) = Arr
End Sub

Nó không chạy được bác ạ. em nhập số vào các Ô khác nó không chạy ra kết quả

 

[HieuCD]

bạn xem file, trong code mình chỉnh ok theo chữ thường cho bạn dễ nhập

 

[thufpts]

bạn xem file, trong code mình chỉnh ok theo chữ thường cho bạn dễ nhập

cảm ơn bác rất nhiều ok rồi bác ạ

 

[thufpts]

bạn xem file, trong code mình chỉnh ok theo chữ thường cho bạn dễ nhập

Bác ơi em không chạy được trên nhiều sheet mà chỉ chạy được ở sheet 1 thôi. nếu em có 100sheet thì làm sao hả bác.

bác giúp em với.