Tìm cao nhân tư vấn cách sắp xếp dòng trong packing list theo điều kiện! có hậu tạ. (1 người xem)

Jacky2025 · 27/2/21

Chào cả nhà,

Em có game khó, nhờ cao nhân tư vấn, sẽ hậu tạ nếu thành công.

Packing list như file em đính kèm.
Các món hàng đôi khi không đóng gói đủ vào 1 thùng. Nếu đóng riêng mỗi món hàng từng thùng thì sẽ tốn nhiều thùng, chi phí cao.
Nên cần kết hợp các món hàng lại với nhau để giảm số lượng thùng.

Bên em có rất nhiều mã hàng, rất nhiều packing list nên làm thủ công không xuể nổi, mong cả nhà giúp sức!

Cám ơn cả nhà!

befaint · 27/2/21

Jacky2025 đã viết:
hậu tạ

Quan tâm khúc này đầu tiên.
Lót dép.

VetMini · 27/2/21

befaint đã viết:
Quan tâm khúc này đầu tiên.
Lót dép.

Quan tâm khúc này hơn:
Rốt cuộc lại thì đây là trò chơi hay làm việc?

Jacky2025 đã viết:
Em có game khó, nhờ cao nhân tư vấn, sẽ hậu tạ nếu thành công.

Packing list như file em đính kèm.

Gặp mấy cái này dép hổng đủ lót.

DarkWanderer · 27/2/21

Jacky2025 đã viết:
Chào cả nhà,

Em có game khó, nhờ cao nhân tư vấn, sẽ hậu tạ nếu thành công.

Packing list như file em đính kèm.
Các món hàng đôi khi không đóng gói đủ vào 1 thùng. Nếu đóng riêng mỗi món hàng từng thùng thì sẽ tốn nhiều thùng, chi phí cao.
Nên cần kết hợp các món hàng lại với nhau để giảm số lượng thùng.

Bên em có rất nhiều mã hàng, rất nhiều packing list nên làm thủ công không xuể nổi, mong cả nhà giúp sức!

Cám ơn cả nhà!

Chủ đề thú vị đấy, xem thử vừa ý bạn chưa

Sắp xếp theo từng loại thùng chứa

Mã:

Sub sapxeptheotungloaithung()
    Dim arr, kq
    Dim i, j, k, h As Long
    Dim dk1 As String, dk2 As Long, mySum As Double
   
    arr = Sheet1.Range("A3:E" & Sheet1.Range("B99999").End(xlUp).Row).Value
    dk1 = Sheet2.Range("H4").Value
    dk2 = Sheet2.Range("I4").Value
    ReDim kq(1 To UBound(arr), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(arr)
            mySum = 0
            If Not .exists(arr(i, 1)) And arr(i, 2) = dk1 Then
                    k = k + 1
                    h = h + 1
                    .Add arr(i, 1), k
                    kq(k, 1) = h
                    kq(k, 2) = arr(i, 2)
                    kq(k, 3) = arr(i, 3)
                    kq(k, 4) = arr(i, 4)
                    kq(k, 5) = arr(i, 5)
                    mySum = mySum + arr(i, 4)
                    For j = 1 To UBound(arr)
                        If Not .exists(arr(j, 1)) And arr(j, 2) = dk1 And arr(j, 4) + mySum <= dk2 Then
                            k = k + 1
                            .Add arr(j, 1), k
                            kq(k, 2) = arr(j, 2)
                            kq(k, 3) = arr(j, 3)
                            kq(k, 4) = arr(j, 4)
                            kq(k, 5) = arr(j, 5)
                            mySum = mySum + arr(j, 4)
                        End If
                    Next j
            End If
        Next i
    End With
    Sheet2.Range("E7:I9999").ClearContents
    Sheet2.Range("E7").Resize(k, 5) = kq
End Sub

Sắp xếp theo 1 danh sách Quy cách đóng thùng có sẵn

Mã:

Sub sapxeptheoBangquycach()
    Dim arr, kq, arrquycach
    Dim i, j, k, h, e As Long
    Dim dk1 As String, dk2 As Long, mySum As Double
    
    arrquycach = Sheet2.Range("M7:N" & Sheet2.Range("M99999").End(xlUp).Row).Value
    arr = Sheet1.Range("A3:E" & Sheet1.Range("B99999").End(xlUp).Row).Value
    ReDim kq(1 To UBound(arr), 1 To 5)
    With CreateObject("Scripting.Dictionary")
    For e = 1 To UBound(arrquycach)
        dk1 = arrquycach(e, 1)
        dk2 = arrquycach(e, 2)
        For i = 1 To UBound(arr)
            mySum = 0
            If Not .exists(arr(i, 1)) And arr(i, 2) = dk1 Then
                    k = k + 1
                    h = h + 1
                    .Add arr(i, 1), k
                    kq(k, 1) = h
                    kq(k, 2) = arr(i, 2)
                    kq(k, 3) = arr(i, 3)
                    kq(k, 4) = arr(i, 4)
                    kq(k, 5) = arr(i, 5)
                    mySum = mySum + arr(i, 4)
                    For j = 1 To UBound(arr)
                        If Not .exists(arr(j, 1)) And arr(j, 2) = dk1 And arr(j, 4) + mySum <= dk2 Then
                            k = k + 1
                            .Add arr(j, 1), k
                            kq(k, 2) = arr(j, 2)
                            kq(k, 3) = arr(j, 3)
                            kq(k, 4) = arr(j, 4)
                            kq(k, 5) = arr(j, 5)
                            mySum = mySum + arr(j, 4)
                        End If
                    Next j
            End If
        Next i
    Next e
    End With
    Sheet2.Range("P7:T9999").ClearContents
    Sheet2.Range("P7").Resize(k, 5) = kq
End Sub

Jacky2025 · 27/2/21

DarkWanderer đã viết:

Chủ đề thú vị đấy, xem thử vừa ý bạn chưa

View attachment 254600

Sắp xếp theo từng loại thùng chứa

Mã:

Sub sapxeptheotungloaithung()
    Dim arr, kq
    Dim i, j, k, h As Long
    Dim dk1 As String, dk2 As Long, mySum As Double
  
    arr = Sheet1.Range("A3:E" & Sheet1.Range("B99999").End(xlUp).Row).Value
    dk1 = Sheet2.Range("H4").Value
    dk2 = Sheet2.Range("I4").Value
    ReDim kq(1 To UBound(arr), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(arr)
            mySum = 0
            If Not .exists(arr(i, 1)) And arr(i, 2) = dk1 Then
                    k = k + 1
                    h = h + 1
                    .Add arr(i, 1), k
                    kq(k, 1) = h
                    kq(k, 2) = arr(i, 2)
                    kq(k, 3) = arr(i, 3)
                    kq(k, 4) = arr(i, 4)
                    kq(k, 5) = arr(i, 5)
                    mySum = mySum + arr(i, 4)
                    For j = 1 To UBound(arr)
                        If Not .exists(arr(j, 1)) And arr(j, 2) = dk1 And arr(j, 4) + mySum <= dk2 Then
                            k = k + 1
                            .Add arr(j, 1), k
                            kq(k, 2) = arr(j, 2)
                            kq(k, 3) = arr(j, 3)
                            kq(k, 4) = arr(j, 4)
                            kq(k, 5) = arr(j, 5)
                            mySum = mySum + arr(j, 4)
                        End If
                    Next j
            End If
        Next i
    End With
    Sheet2.Range("E7:I9999").ClearContents
    Sheet2.Range("E7").Resize(k, 5) = kq
End Sub

Sắp xếp theo 1 danh sách Quy cách đóng thùng có sẵn

Mã:

Sub sapxeptheoBangquycach()
    Dim arr, kq, arrquycach
    Dim i, j, k, h, e As Long
    Dim dk1 As String, dk2 As Long, mySum As Double
   
    arrquycach = Sheet2.Range("M7:N" & Sheet2.Range("M99999").End(xlUp).Row).Value
    arr = Sheet1.Range("A3:E" & Sheet1.Range("B99999").End(xlUp).Row).Value
    ReDim kq(1 To UBound(arr), 1 To 5)
    With CreateObject("Scripting.Dictionary")
    For e = 1 To UBound(arrquycach)
        dk1 = arrquycach(e, 1)
        dk2 = arrquycach(e, 2)
        For i = 1 To UBound(arr)
            mySum = 0
            If Not .exists(arr(i, 1)) And arr(i, 2) = dk1 Then
                    k = k + 1
                    h = h + 1
                    .Add arr(i, 1), k
                    kq(k, 1) = h
                    kq(k, 2) = arr(i, 2)
                    kq(k, 3) = arr(i, 3)
                    kq(k, 4) = arr(i, 4)
                    kq(k, 5) = arr(i, 5)
                    mySum = mySum + arr(i, 4)
                    For j = 1 To UBound(arr)
                        If Not .exists(arr(j, 1)) And arr(j, 2) = dk1 And arr(j, 4) + mySum <= dk2 Then
                            k = k + 1
                            .Add arr(j, 1), k
                            kq(k, 2) = arr(j, 2)
                            kq(k, 3) = arr(j, 3)
                            kq(k, 4) = arr(j, 4)
                            kq(k, 5) = arr(j, 5)
                            mySum = mySum + arr(j, 4)
                        End If
                    Next j
            End If
        Next i
    Next e
    End With
    Sheet2.Range("P7:T9999").ClearContents
    Sheet2.Range("P7").Resize(k, 5) = kq
End Sub

Đúng nó rồi bạn! bạn chịu khó giải thích code + vòng lặp giúp mình với...
Mình là dân ko chuyên. Tiện thể hồi mình gửi bác card dt 50K để cám ơn. Bác xài mạng nào?

DarkWanderer · 27/2/21

Jacky2025 đã viết:
Đúng nó rồi bạn! bạn chịu khó giải thích code + vòng lặp giúp mình với...
Mình là dân ko chuyên. Tiện thể hồi mình gửi bác card dt 50K để cám ơn. Bác xài mạng nào?

Ví dụ: Đầu tiên mình cần đóng gói với loại thùng Thau, số lượng tối đa 10
- Vòng lặp i: Chạy vòng lặp để tìm các dòng có cột 2 (Mã hàng) bằng Thau, khi tìm được 1 dòng có Mã hàng Thau rồi sẽ chạy vòng lặp j
- Vòng lặp j: Chạy vòng lặp để tìm tiếp các cột Mã hàng Thau, đồng thời dòng nào cộng Số lượng với kết quả tại vòng lặp i, nếu dòng nào Tổng<= 10 thì lấy

Bạn lưu ý mấy chỗ để thay đổi cho phù hợp với file công việc:

Nạp dữ liệu Quy cách đóng thùng
arrquycach = Sheet2.Range("M7:N" & Sheet2.Range("M99999").End(xlUp).Row).Value
Nạp dữ liệu các mặt hàng cần đóng thùng
arr = Sheet1.Range("A3:E" & Sheet1.Range("B99999").End(xlUp).Row).Value
Xóa dữ liệu cũ tại vị trí muốn ghi Kết quả
Sheet2.Range("P7:T9999").ClearContents
Số cột của bảng Kết quả 5
ReDim kq(1 To UBound(arr), 1 To 5)
Số cột của bảng Kết quả 5, P7 là ô đầu tiên của bảng Kết quả
Sheet2.Range("P7").Resize(k, 5) = kq

Bạn áp dụng thành công code vào công việc của mình đã nhé, mình cũng không biết giải thích sao nữa, toàn dùng nhiều quen thôi

be_09 · 27/2/21

Jacky2025 đã viết:
Chào cả nhà,

Em có game khó, nhờ cao nhân tư vấn, sẽ hậu tạ nếu thành công.

Packing list như file em đính kèm.
Các món hàng đôi khi không đóng gói đủ vào 1 thùng. Nếu đóng riêng mỗi món hàng từng thùng thì sẽ tốn nhiều thùng, chi phí cao.
Nên cần kết hợp các món hàng lại với nhau để giảm số lượng thùng.

Bên em có rất nhiều mã hàng, rất nhiều packing list nên làm thủ công không xuể nổi, mong cả nhà giúp sức!

Cám ơn cả nhà!

Góp ý cho bạn: Bạn mới tham gia Diễn đàn thì nên chú ý những điều sau đây.
1/ Diễn đàn Excel mang tính hỗ trợ, giúp đỡ, người biết giúp người chưa biết.
2/ Vì vậy, tiêu đề bài viết không nên rườm rà những cụm từ thế này "Tìm cao nhân", "có hậu tạ" và nội dung thế này thì quá thừa nhưng không giúp ích gì cho chính bản thân mình "Chào cả nhà", "Em có game khó, nhờ cao nhân tư vấn, sẽ hậu tạ nếu thành công".
sẽ gây phản cãm với mọi người. Mà tiêu đề bài viết nên ngắn gọn thế này "Tư vấn cách sắp xếp dòng trong packing list theo điều kiện".
3/ Nếu bạn muốn hậu tạ ai đó thì nên nhắn tin riêng với người đã bỏ công sức giúp mình.

Jacky2025 · 27/2/21

be_09 đã viết:
Góp ý cho bạn: Bạn mới tham gia Diễn đàn thì nên chú ý những điều sau đây.
1/ Diễn đàn Excel mang tính hỗ trợ, giúp đỡ, người biết giúp người chưa biết.
2/ Vì vậy, tiêu đề bài viết không nên rườm rà những cụm từ thế này "Tìm cao nhân", "có hậu tạ" và nội dung thế này thì quá thừa nhưng không giúp ích gì cho chính bản thân mình "Chào cả nhà", "Em có game khó, nhờ cao nhân tư vấn, sẽ hậu tạ nếu thành công".
sẽ gây phản cãm với mọi người. Mà tiêu đề bài viết nên ngắn gọn thế này "Tư vấn cách sắp xếp dòng trong packing list theo điều kiện".
3/ Nếu bạn muốn hậu tạ ai đó thì nên nhắn tin riêng với người đã bỏ công sức g

DarkWanderer đã viết:
Ví dụ: Đầu tiên mình cần đóng gói với loại thùng Thau, số lượng tối đa 10
- Vòng lặp i: Chạy vòng lặp để tìm các dòng có cột 2 (Mã hàng) bằng Thau, khi tìm được 1 dòng có Mã hàng Thau rồi sẽ chạy vòng lặp j
- Vòng lặp j: Chạy vòng lặp để tìm tiếp các cột Mã hàng Thau, đồng thời dòng nào cộng Số lượng với kết quả tại vòng lặp i, nếu dòng nào Tổng<= 10 thì lấy

Bạn lưu ý mấy chỗ để thay đổi cho phù hợp với file công việc:

Nạp dữ liệu Quy cách đóng thùng
arrquycach = Sheet2.Range("M7:N" & Sheet2.Range("M99999").End(xlUp).Row).Value
Nạp dữ liệu các mặt hàng cần đóng thùng
arr = Sheet1.Range("A3:E" & Sheet1.Range("B99999").End(xlUp).Row).Value
Xóa dữ liệu cũ tại vị trí muốn ghi Kết quả
Sheet2.Range("P7:T9999").ClearContents
Số cột của bảng Kết quả 5
ReDim kq(1 To UBound(arr), 1 To 5)
Số cột của bảng Kết quả 5, P7 là ô đầu tiên của bảng Kết quả
Sheet2.Range("P7").Resize(k, 5) = kq

Bạn áp dụng thành công code vào công việc của mình đã nhé, mình cũng không biết giải thích sao nữa, toàn dùng nhiều quen thôi

Cám ơn bạn nhiều nhé!

Bài đã được tự động gộp: 27/2/21

be_09 đã viết:
Góp ý cho bạn: Bạn mới tham gia Diễn đàn thì nên chú ý những điều sau đây.
1/ Diễn đàn Excel mang tính hỗ trợ, giúp đỡ, người biết giúp người chưa biết.
2/ Vì vậy, tiêu đề bài viết không nên rườm rà những cụm từ thế này "Tìm cao nhân", "có hậu tạ" và nội dung thế này thì quá thừa nhưng không giúp ích gì cho chính bản thân mình "Chào cả nhà", "Em có game khó, nhờ cao nhân tư vấn, sẽ hậu tạ nếu thành công".
sẽ gây phản cãm với mọi người. Mà tiêu đề bài viết nên ngắn gọn thế này "Tư vấn cách sắp xếp dòng trong packing list theo điều kiện".
3/ Nếu bạn muốn hậu tạ ai đó thì nên nhắn tin riêng với người đã bỏ công sức giúp mình.

Ok bạn, mình mới tham gia nên cám ơn góp ý của bạn và sẽ chú ý lần sau!

Phụ Hồ Lên Phú Hộ · 27/2/21

DarkWanderer đã viết:

Chủ đề thú vị đấy, xem thử vừa ý bạn chưa

View attachment 254600

Sắp xếp theo từng loại thùng chứa

Mã:

Sub sapxeptheotungloaithung()
    Dim arr, kq
    Dim i, j, k, h As Long
    Dim dk1 As String, dk2 As Long, mySum As Double
   
    arr = Sheet1.Range("A3:E" & Sheet1.Range("B99999").End(xlUp).Row).Value
    dk1 = Sheet2.Range("H4").Value
    dk2 = Sheet2.Range("I4").Value
    ReDim kq(1 To UBound(arr), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(arr)
            mySum = 0
            If Not .exists(arr(i, 1)) And arr(i, 2) = dk1 Then
                    k = k + 1
                    h = h + 1
                    .Add arr(i, 1), k
                    kq(k, 1) = h
                    kq(k, 2) = arr(i, 2)
                    kq(k, 3) = arr(i, 3)
                    kq(k, 4) = arr(i, 4)
                    kq(k, 5) = arr(i, 5)
                    mySum = mySum + arr(i, 4)
                    For j = 1 To UBound(arr)
                        If Not .exists(arr(j, 1)) And arr(j, 2) = dk1 And arr(j, 4) + mySum <= dk2 Then
                            k = k + 1
                            .Add arr(j, 1), k
                            kq(k, 2) = arr(j, 2)
                            kq(k, 3) = arr(j, 3)
                            kq(k, 4) = arr(j, 4)
                            kq(k, 5) = arr(j, 5)
                            mySum = mySum + arr(j, 4)
                        End If
                    Next j
            End If
        Next i
    End With
    Sheet2.Range("E7:I9999").ClearContents
    Sheet2.Range("E7").Resize(k, 5) = kq
End Sub

Sắp xếp theo 1 danh sách Quy cách đóng thùng có sẵn

Mã:

Sub sapxeptheoBangquycach()
    Dim arr, kq, arrquycach
    Dim i, j, k, h, e As Long
    Dim dk1 As String, dk2 As Long, mySum As Double
    
    arrquycach = Sheet2.Range("M7:N" & Sheet2.Range("M99999").End(xlUp).Row).Value
    arr = Sheet1.Range("A3:E" & Sheet1.Range("B99999").End(xlUp).Row).Value
    ReDim kq(1 To UBound(arr), 1 To 5)
    With CreateObject("Scripting.Dictionary")
    For e = 1 To UBound(arrquycach)
        dk1 = arrquycach(e, 1)
        dk2 = arrquycach(e, 2)
        For i = 1 To UBound(arr)
            mySum = 0
            If Not .exists(arr(i, 1)) And arr(i, 2) = dk1 Then
                    k = k + 1
                    h = h + 1
                    .Add arr(i, 1), k
                    kq(k, 1) = h
                    kq(k, 2) = arr(i, 2)
                    kq(k, 3) = arr(i, 3)
                    kq(k, 4) = arr(i, 4)
                    kq(k, 5) = arr(i, 5)
                    mySum = mySum + arr(i, 4)
                    For j = 1 To UBound(arr)
                        If Not .exists(arr(j, 1)) And arr(j, 2) = dk1 And arr(j, 4) + mySum <= dk2 Then
                            k = k + 1
                            .Add arr(j, 1), k
                            kq(k, 2) = arr(j, 2)
                            kq(k, 3) = arr(j, 3)
                            kq(k, 4) = arr(j, 4)
                            kq(k, 5) = arr(j, 5)
                            mySum = mySum + arr(j, 4)
                        End If
                    Next j
            End If
        Next i
    Next e
    End With
    Sheet2.Range("P7:T9999").ClearContents
    Sheet2.Range("P7").Resize(k, 5) = kq
End Sub

Mình xin phép tham khảo code nhé

Tìm cao nhân tư vấn cách sắp xếp dòng trong packing list theo điều kiện! có hậu tạ. (1 người xem)

Người dùng đang xem chủ đề này

Jacky2025

Thành viên mới

File đính kèm

befaint

|||||||||||||

VetMini

Đang đi tìm hòn đá

DarkWanderer

Thành viên hoạt động

File đính kèm

Jacky2025

Thành viên mới

DarkWanderer

Thành viên hoạt động

be_09

Biên Hòa, Đồng Nai

Jacky2025

Thành viên mới

Phụ Hồ Lên Phú Hộ

Thành viên chính thức

Bài viết mới nhất

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

Sinh nhật lần 19 GPE