Chia số lượng theo điều kiện

[Together11]

Làm đại:

Option Explicit
Sub collection()
Dim lr&, lc&, i&, j&, k&, sG&, sC&, max&, sum&
Dim rng, rng2, arr(), ch As String
Worksheets("Sheet1").Activate
lr = Cells(Rows.Count, "A").End(xlUp).Row
lc = Cells(2, Columns.Count).End(xlToLeft).Column
rng = Range("B2", Cells(lr, lc)).Value
rng2 = Range("B2", Cells(lr, lc)).Value
Worksheets("Sheet2").Range("A2:M100").ClearContents
ReDim arr(1 To lr - 1, 1 To lc - 1)
    For i = 2 To lr - 1
        max = 0
        For j = 2 To lc - 3
            For k = j + 1 To lc - 2
                If rng(i, j) < rng(i, k) Then
                    max = rng(i, k): ch = rng(1, k)
                    rng(i, k) = rng(i, j): rng(1, k) = rng(1, j)
                    rng(i, j) = max: rng(1, j) = ch
                End If
            Next
        Next
    Next
    With WorksheetFunction
        For i = 2 To lr - 1
            sG = .Min(rng(i, 1), rng(i, lc - 1)): rng(i, 1) = sG
            sC = rng(i, lc - 1) - sG
            sum = sG
            For j = 2 To lc - 2
                sG = .Min(Round(rng(i, j) * (1 - Range("M1")), 0), sC): rng(i, j) = sG
                sC = sC - sG
                sum = sum + sG
            Next
            rng(i, lc - 1) = sum
            For j = 2 To lc - 2
                For k = 2 To lc - 2
                    If rng2(1, j) = rng(1, k) Then
                        max = rng(i, j): ch = rng(1, j)
                        rng(i, j) = rng(i, k): rng(1, j) = rng(1, k)
                        rng(i, k) = max: rng(1, k) = ch
                    End If
                Next
            Next
        Next
    End With
Worksheets("Sheet2").Activate
Range("B2").Resize(i - 1, j).Value = rng
Range("A2").Resize(i - 1, 1).Value = Worksheets("Sheet1").Range("A2:A" & lr).Value
End Sub

Xin cảm ơn bác ạ

 

[Together11]

Làm đại:

Option Explicit
Sub collection()
Dim lr&, lc&, i&, j&, k&, sG&, sC&, max&, sum&
Dim rng, rng2, arr(), ch As String
Worksheets("Sheet1").Activate
lr = Cells(Rows.Count, "A").End(xlUp).Row
lc = Cells(2, Columns.Count).End(xlToLeft).Column
rng = Range("B2", Cells(lr, lc)).Value
rng2 = Range("B2", Cells(lr, lc)).Value
Worksheets("Sheet2").Range("A2:M100").ClearContents
ReDim arr(1 To lr - 1, 1 To lc - 1)
    For i = 2 To lr - 1
        max = 0
        For j = 2 To lc - 3
            For k = j + 1 To lc - 2
                If rng(i, j) < rng(i, k) Then
                    max = rng(i, k): ch = rng(1, k)
                    rng(i, k) = rng(i, j): rng(1, k) = rng(1, j)
                    rng(i, j) = max: rng(1, j) = ch
                End If
            Next
        Next
    Next
    With WorksheetFunction
        For i = 2 To lr - 1
            sG = .Min(rng(i, 1), rng(i, lc - 1)): rng(i, 1) = sG
            sC = rng(i, lc - 1) - sG
            sum = sG
            For j = 2 To lc - 2
                sG = .Min(Round(rng(i, j) * (1 - Range("M1")), 0), sC): rng(i, j) = sG
                sC = sC - sG
                sum = sum + sG
            Next
            rng(i, lc - 1) = sum
            For j = 2 To lc - 2
                For k = 2 To lc - 2
                    If rng2(1, j) = rng(1, k) Then
                        max = rng(i, j): ch = rng(1, j)
                        rng(i, j) = rng(i, k): rng(1, j) = rng(1, k)
                        rng(i, k) = max: rng(1, k) = ch
                    End If
                Next
            Next
        Next
    End With
Worksheets("Sheet2").Activate
Range("B2").Resize(i - 1, j).Value = rng
Range("A2").Resize(i - 1, 1).Value = Worksheets("Sheet1").Range("A2:A" & lr).Value
End Sub

Bác ơi bác sửa giúp em :
1. Nhặt hàng từ CH tồn nhiều nhất đến CH tồn ít nhất
2. Tại các CH thì Nhân với tỷ lệ đặt tại 1 ô bất kì ạ, nếu sau khi nhân theo tỷ lệ mà thiếu thì cứ để số lượng tối đa mà nhặt được, em sẽ thêm CH vào để nhặt tiếp ạ.
( Em vẫn chưa hiểu bác đang đặt code như thế nào nhưng có CH chỉ tồn 82 nhưng lấy tận 100 )
3. Trả về 1 bảng nữa để biết : Mã Hàng A Chuyển từ CH1 Số lượng chuyển xx
Em cảm ơn bác ạ

 

[Together11]

Em cần trả về 2 cái bảng như dạng bác gì ở trên làm đó ạ.
Bảng ở dưới bảng gốc, số lượng còn lại ở mỗi CH sau khi chuyển cho CH nhận
Bảng bên cạnh hiện nội dung như ví dụ trong ảnh này ạ.

 

[CHAOQUAY]

Em cần trả về 2 cái bảng như dạng bác gì ở trên làm đó ạ.
Bảng ở dưới bảng gốc, số lượng còn lại ở mỗi CH sau khi chuyển cho CH nhận
Bảng bên cạnh hiện nội dung như ví dụ trong ảnh này ạ.

View attachment 277715

Chèn thêm 1 sheet, đặt tên là "Chitiet", chạy code dưới đây.
Bảng gốc bên trên, bảng dưới là số lượng còn lại. Riêng cột cuối bảng dưới là số đã chuyển

Option Explicit

Sub phanHang()
Dim Nguon
Dim Kq
Dim Tl
Dim TongN
Dim TongX
Dim Vt, Sl
Dim rws, cls
Dim i, j, k, x, z, t

Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlToRight).End(xlDown))
rws = UBound(Nguon)
cls = UBound(Nguon, 2)

Sheets("Chitiet").UsedRange.Clear
Sheets("Chitiet").Range("A3").Resize(rws, cls) = Nguon

Tl = Sheet1.Range("L1")

Kq = Nguon
For i = 2 To rws
    For j = 3 To cls
        Kq(i, j) = Empty
    Next j
Next i

For i = 2 To rws
    For j = 3 To cls - 1
        k = Nguon(i, j) * 100 + j
        Nguon(i, j) = k
    Next j
    
    For j = 3 To cls - 2
        For k = j + 1 To cls - 1
            If Nguon(i, k) > Nguon(i, j) Then
                t = Nguon(i, k)
                Nguon(i, k) = Nguon(i, j)
                Nguon(i, j) = t
            End If
        Next k
    Next j
    
    TongN = Nguon(i, cls) - Nguon(i, 2)
    Kq(i, cls) = Kq(i, 2)
    Kq(i, 2) = Empty
    If TongN > 0 Then
        TongX = 0
        For j = 3 To cls - 1
            Vt = Nguon(i, j) Mod 100
            Sl = Nguon(i, j) \ 100
            
            x = Int(Tl * Sl)
            If TongX + x < TongN Then
                z = x
            Else
                z = TongN - TongX
            End If
            
            If z Then
                'Kq(i, Vt) = z
                Kq(i, Vt) = Sl - z
                TongX = TongX + z
            End If
        Next j
        
        Kq(i, cls) = Kq(i, cls) + TongX
    End If
Next i

With Sheets("Chitiet")
    .Range("A3").End(xlDown).Offset(2).Resize(rws, cls) = Kq
    .UsedRange.Columns.AutoFit
End With
End Sub

 

[Together11]

Chèn thêm 1 sheet, đặt tên là "Chitiet", chạy code dưới đây.
Bảng gốc bên trên, bảng dưới là số lượng còn lại. Riêng cột cuối bảng dưới là số đã chuyển

Option Explicit

Sub phanHang()
Dim Nguon
Dim Kq
Dim Tl
Dim TongN
Dim TongX
Dim Vt, Sl
Dim rws, cls
Dim i, j, k, x, z, t

Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlToRight).End(xlDown))
rws = UBound(Nguon)
cls = UBound(Nguon, 2)

Sheets("Chitiet").UsedRange.Clear
Sheets("Chitiet").Range("A3").Resize(rws, cls) = Nguon

Tl = Sheet1.Range("L1")

Kq = Nguon
For i = 2 To rws
    For j = 3 To cls
        Kq(i, j) = Empty
    Next j
Next i

For i = 2 To rws
    For j = 3 To cls - 1
        k = Nguon(i, j) * 100 + j
        Nguon(i, j) = k
    Next j
   
    For j = 3 To cls - 2
        For k = j + 1 To cls - 1
            If Nguon(i, k) > Nguon(i, j) Then
                t = Nguon(i, k)
                Nguon(i, k) = Nguon(i, j)
                Nguon(i, j) = t
            End If
        Next k
    Next j
   
    TongN = Nguon(i, cls) - Nguon(i, 2)
    Kq(i, cls) = Kq(i, 2)
    Kq(i, 2) = Empty
    If TongN > 0 Then
        TongX = 0
        For j = 3 To cls - 1
            Vt = Nguon(i, j) Mod 100
            Sl = Nguon(i, j) \ 100
           
            x = Int(Tl * Sl)
            If TongX + x < TongN Then
                z = x
            Else
                z = TongN - TongX
            End If
           
            If z Then
                'Kq(i, Vt) = z
                Kq(i, Vt) = Sl - z
                TongX = TongX + z
            End If
        Next j
       
        Kq(i, cls) = Kq(i, cls) + TongX
    End If
Next i

With Sheets("Chitiet")
    .Range("A3").End(xlDown).Offset(2).Resize(rws, cls) = Kq
    .UsedRange.Columns.AutoFit
End With
End Sub

Vô cùng cảm ơn bác ạ, Mong bác bớt chút time thêm giúp em cái phần như ảnh là Done ạ.

 

[CHAOQUAY]

View attachment 277721
Vô cùng cảm ơn bác ạ, Mong bác bớt chút time thêm giúp em cái phần như ảnh là Done ạ.

Chạy macro "phanHang" trong file đính kèm

---
Luu ý là số cửa hàng của 1 mã hàng <100

 

[HUONGHCKT]

Bạn ơi nếu số lượng CH ko phải chỉ là 10 mà còn tăng lên hoặc giảm đi thì mình lấy biến cột cuối gán vào ntn Và hiện tại mình thử chạy CODE vẫn bị nhặt quá số lượng mà CH nhận cần ạ.
Mong bạn hỗ trợ nốt mình với nhé, cảm ơn bạn nhiều ạ.

Tốt nhất là bạn đưa file lên. Chứ chỉ nói không với nhìn ảnh thì không có thời gian để luận và đình hình xem nó là cái gì? Do vậy có code được cũng chỉ là đoán mò===> đúng sai không nói trước được (vì có hiểu ý và có dữ liệu đâu để thử).
Đoán Mò ý bạn là Trong một bảng có nhiều cửa hàng(CH) nhưng có mã bạn muốn nhặt đến CH cuối cùng có mã bạn lại chỉ muốn nhặt đến CHn nào đó. Nếu đúng vậy phải code lại.
Nếu nhìn như ảnh bài thì có lẽ là sửa lại code ở bài #17
Từ:

For j = 2 To UBound(Arr, 2)

thành

For j = 2 To UBound(Arr, 2)-1

Hy vọng đúng

 

[Together11]

Tốt nhất là bạn đưa file lên. Chứ chỉ nói không với nhìn ảnh thì không có thời gian để luận và đình hình xem nó là cái gì? Do vậy có code được cũng chỉ là đoán mò===> đúng sai không nói trước được (vì có hiểu ý và có dữ liệu đâu để thử).
Đoán Mò ý bạn là Trong một bảng có nhiều cửa hàng(CH) nhưng có mã bạn muốn nhặt đến CH cuối cùng có mã bạn lại chỉ muốn nhặt đến CHn nào đó. Nếu đúng vậy phải code lại.
Nếu nhìn như ảnh bài thì có lẽ là sửa lại code ở bài #17
Từ:

For j = 2 To UBound(Arr, 2)

thành

For j = 2 To UBound(Arr, 2)-1

Hy vọng đúng

Dạ file mình có đưa lên rồi ạ. Cảm ơn bạn nhé. Sau mình xin rút kinh nghiệm ạ

 

[Together11]

Chạy macro "phanHang" trong file đính kèm

---
Luu ý là số cửa hàng của 1 mã hàng <100

File chạy ok rồi. Cảm ơn bác rất nhiều ạ

 

[Together11]

Bác ơi, cảm ơn lần trước bác đã hỗ trợ
Hôm nay có vấn đề này của em mong nhận được sự hỗ trợ từ bác và các anh chị em trong diễn đàn GPE ạ.
Em có bài toán chia hàng tương tự như bài của bác chủ topic nhưng khác đôi chút ở phần quy luật, nhờ bác viết giúp em đoạn code VBA chạy phần này với ạ.
Em gửi file và ảnh :

Chạy macro "phanHang" trong file đính kèm

---
Luu ý là số cửa hàng của 1 mã hàng <100