Chia số lượng nhập theo số lượng bán

[tocxuu]

Em chào các anh chị trong diễn đàn,
Em có bài toán này nhờ các anh chị giúp đỡ.
Em có dữ liệu đầu vào tại Sheet Data, và kết quả cần chạy ra ở Sheet Ketqua.
Em có 1 lượng hàng trên tờ khai xuất ra em cần biết lượng hàng này được xuất ra của những tờ khai nhập nào ạ. Em có làm dữ liệu mẫu bên sheet KetQua.
Vùng xuất từ A8-F12, tờ khai nhập là từ vùng G8:I13.
Chi tiết yêu cầu em cũng có diễn giải trong sheet Yêu cầu của file đính kèm ạ.
Em mong muốn được giúp đỡ bằng VBA ạ để em có thể thêm dữ liệu nhập và xuất sau đó chạy code.
Em cảm ơn các anh chị ạ.

 

[tocxuu]

Em chào các anh chị,
Không biết em có chỗ nào diễn đạt chưa rõ nghĩa không mà đến 6 lượt tải chưa ai giúp em ạ. huhu
Em cảm ơn.

 

[le_vis]

Em chào các anh chị,
Không biết em có chỗ nào diễn đạt chưa rõ nghĩa không mà đến 6 lượt tải chưa ai giúp em ạ. huhu
Em cảm ơn.

Chắc chỉ có "thánh" mới hiểu được ý đồ của Bạn !
Cần giải thích rõ : ví dụ tại Sheet Ketqua Cột I [Số lượng nhập] lấy sang dựa vào cái gì ? Nếu dựa vào [số tờ khai nhập khẩu] thì dữ liệu [số tờ khai nhập khẩu] nhập tay vào hay kết chuyển sang; nếu kết chuyển sang thì dựa vào đâu ???... ???...
Và còn nhiều cái cần được làm rõ vì không ai hiểu được bạn muốn gì nên chưa có người giúp thôi

 

[Maika8008]

Chắc chỉ có "thánh" mới hiểu được ý đồ của Bạn !
Cần giải thích rõ : ví dụ tại Sheet Ketqua Cột I [Số lượng nhập] lấy sang dựa vào cái gì ? Nếu dựa vào [số tờ khai nhập khẩu] thì dữ liệu [số tờ khai nhập khẩu] nhập tay vào hay kết chuyển sang; nếu kết chuyển sang thì dựa vào đâu ???... ???...
Và còn nhiều cái cần được làm rõ vì không ai hiểu được bạn muốn gì nên chưa có người giúp thôi

Ý đồ là nhập trước thì xuất trước y như 1 cách tính giá xuất vật tư trong kế toán ấy mà.

 

[tocxuu]

Dạ vâng,
Xin cảm ơn sự quan tâm của bạn đến vấn đề của mình.
Mình xin làm rõ yêu cầu của mình như sau, bản chất bài toán này là theo phương pháp nhập trước xuất trước.
1. Dữ liệu đầu vào là sheet Data và dữ liệu đầu ra là sheet KetQua ạ.
2.Sheet KetQua logic lấy dữ liệu như sau :
Ta có dữ liệu xuất phát từ dòng số 8 tại ô D8 có số lượng xuất là : 2000 số lượng xuất này được lấy từ :
+Lần nhập của tờ khai 101020....830 : 150 - ô I8
+ Lần nhập của tờ khai 10104....7700 : 50 - ô I9
+Lần nhập của tờ khai 10109....2250 : 1800 - Số lượng tờ khai này là 10.000 nhưng với lần xuất thứ nhất 2000 thì chỉ cần 1800 phần còn lại 8200 mang đi chia tiếp cho lần xuất của tờ khai xuất ở ô D9 : 2000 ...
Cứ như vậy sẽ được kết quả như sheet KetQua. Sau khi chia hết số lượng phần còn dư chưa xuất sẽ dồn dữ liệu xuống dưới sau khi chia hết số đã khớp với bên xuất.
Như trong bài toán này là còn dư 63,200 chưa xuất ạ.

 

[bebo021999]

Với dạng nhập xuất hỗn hợp thế này, thường người ta hay theo dõi theo dạng bảng 3D.
Xem file đính kèm.
Từ kết quả này, muốn trích xuất ra report dạng nào cũng được.

 

[Maika8008]

Em chào các anh chị trong diễn đàn,
Em có bài toán này nhờ các anh chị giúp đỡ.
Em có dữ liệu đầu vào tại Sheet Data, và kết quả cần chạy ra ở Sheet Ketqua.
Em có 1 lượng hàng trên tờ khai xuất ra em cần biết lượng hàng này được xuất ra của những tờ khai nhập nào ạ. Em có làm dữ liệu mẫu bên sheet KetQua.
Vùng xuất từ A8-F12, tờ khai nhập là từ vùng G8:I13.
Chi tiết yêu cầu em cũng có diễn giải trong sheet Yêu cầu của file đính kèm ạ.
Em mong muốn được giúp đỡ bằng VBA ạ để em có thể thêm dữ liệu nhập và xuất sau đó chạy code.
Em cảm ơn các anh chị ạ.

Bạn chạy với dữ liệu thực xem thế nào. Yêu cầu cấu trúc data phải giống hệt như vậy, nếu không giống thì tôi không biết kết quả ra cái gì nữa à.

 

[tocxuu]

Bạn chạy với dữ liệu thực xem thế nào. Yêu cầu cấu trúc data phải giống hệt như vậy, nếu không giống thì tôi không biết kết quả ra cái gì nữa à.

Cảm ơn Maika rất nhiều.
Mình đã test thử với dữ liệu thật của mình thì ra kết quả chưa mong muốn.
Mình gửi bạn file mình Tets thử với code của bạn và kết quả đúng.
Cảm ơn sự quan tâm của bạn đến vấn đề của mình.

 

[Maika8008]

Cảm ơn Maika rất nhiều.
Mình đã test thử với dữ liệu thật của mình thì ra kết quả chưa mong muốn.
Mình gửi bạn file mình Tets thử với code của bạn và kết quả đúng.
Cảm ơn sự quan tâm của bạn đến vấn đề của mình.

Để hồi rảnh làm. Ngó vậy không đơn giản.

 

[HieuCD]

Cảm ơn Maika rất nhiều.
Mình đã test thử với dữ liệu thật của mình thì ra kết quả chưa mong muốn.
Mình gửi bạn file mình Tets thử với code của bạn và kết quả đúng.
Cảm ơn sự quan tâm của bạn đến vấn đề của mình.

Chạy code

Option Explicit

Sub ABC()
  Dim aXuat(), aNhap(), Res(), tmp#
  Dim srXuat&, srNhap&, i&, r&, k&, j&, fRow&
 
  With Sheet1
    aXuat = .Range("A8", .Range("F" & Rows.Count).End(xlUp)).Value
    aNhap = .Range("G8", .Range("I" & Rows.Count).End(xlUp)).Value
  End With
  srXuat = UBound(aXuat):         srNhap = UBound(aNhap)
  ReDim Res(1 To srXuat + srNhap, 1 To 9)
  fRow = 1
  For i = 1 To srXuat
    tmp = aXuat(i, 4)
    For j = 1 To 6
      Res(k + 1, j) = aXuat(i, j)
    Next j
    For r = fRow To srNhap
      If aNhap(r, 3) > 0 Then
        k = k + 1
        Res(k, 7) = aNhap(r, 1):      Res(k, 8) = aNhap(r, 2)
        If aNhap(r, 3) >= tmp Then
          Res(k, 9) = tmp
          aNhap(r, 3) = aNhap(r, 3) - tmp
          If aNhap(r, 3) = 0 Then fRow = r + 1 Else fRow = r
          Exit For
        Else
          Res(k, 9) = aNhap(r, 3)
          tmp = tmp - aNhap(r, 3)
        End If
      End If
    Next r
  Next i
  For r = fRow To srNhap
    If aNhap(r, 3) > 0 Then
      k = k + 1
      Res(k, 7) = aNhap(r, 1)
      Res(k, 8) = aNhap(r, 2)
      Res(k, 9) = aNhap(r, 3)
    End If
  Next r
  With Sheet2
    .Range("A7", .Range("I" & Rows.Count).End(xlUp)).ClearContents
    Union(.Range("A7").Resize(k, 2), .Range("G7").Resize(k)).NumberFormat = "@"
    .Range("A7").Resize(k, 9) = Res
  End With
End Sub

 

[Maika8008]

Để hồi rảnh làm. Ngó vậy không đơn giản.

Bạn thử code & file

Sub PBSLBan()
Dim arrB, arrN, arrKQ
Dim i&, k&, c&, d&, Ban#, Nhap#, LKBan#
Dim chk As Boolean

arrB = Sheet1.Range("A8:H" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
arrN = Sheet1.Range("I8:I" & Sheet1.Range("I" & Rows.Count).End(xlUp).Row)
ReDim arrKQ(1 To 1000, 1 To 9)
For i = 1 To UBound(arrN)
    Nhap = Nhap + arrN(i, 1)
    Do Until Ban >= Nhap
        d = d + 1
        If d > UBound(arrB) Then chk = True: GoTo End_
        k = k + 1: Ban = Ban + arrB(d, 4)
        For c = 1 To UBound(arrB, 2) - 2: arrKQ(k, c) = arrB(d, c): Next
        arrKQ(k, 7) = arrB(i, 7): arrKQ(k, 8) = arrB(i, 8)
        arrKQ(k, 9) = arrB(d, 4)
        LKBan = 0
    Loop
    If Ban > Nhap Then
        Ban = Ban - arrKQ(k, 9)
        arrKQ(k, 9) = Nhap - Ban
        k = k + 1: arrKQ(k, 9) = arrB(d, 4) - LKBan - (Nhap - Ban)
        For c = 1 To UBound(arrB, 2) - 2: arrKQ(k, c) = arrB(d, c): Next
        arrKQ(k, 7) = arrB(i + 1, 7): arrKQ(k, 8) = arrB(i + 1, 8)
        LKBan = LKBan + (Nhap - Ban)
        Ban = arrKQ(k, 9): Nhap = 0
    End If
Ctn: Next
End_:
If chk = True Then
    k = k + 1: arrKQ(k, 9) = Nhap - Ban
    On Error Resume Next    
    arrKQ(k, 7) = arrB(i, 7): arrKQ(k, 8) = arrB(i, 8)
    On Error GoTo 0
    Nhap = 0: Ban = 0: chk = False: GoTo Ctn
End If
Sheet2.Range("A7").Resize(1000, 9).ClearContents
Sheet2.Range("A7").Resize(k, 9) = arrKQ
End Sub

 

[Ba Tê]

1 kiểu Code dễ đọc, giống như Nhập trước - Xuất trước.

Option Explicit

Public Sub sGpe()
Dim ArrX(), ArrN(), dArr(), Xuat As Double
Dim I As Long, J As Long, K As Long, N As Long, R As Long, R2 As Long, x As Long
    ArrX = Sheets("Data").Range("A8", Sheets("Data").Range("A8").End(xlDown)).Resize(, 6).Value
    R = UBound(ArrX)
    ArrN = Sheets("Data").Range("G8", Sheets("Data").Range("G8").End(xlDown)).Resize(, 3).Value
    R2 = UBound(ArrN)
ReDim dArr(1 To R * 10, 1 To 9)
For I = 1 To R
    '==========Lay du lieu Xuat'
    Xuat = ArrX(I, 4)
    K = K + 1
    For J = 1 To 6
        dArr(K, J) = ArrX(I, J)
    Next J
    K = K - 1
    '================Lay du lieu Nhap'
    For N = 1 To R2
        If ArrN(N, 3) > 0 Then
            K = K + 1
            dArr(K, 7) = ArrN(N, 1)
            dArr(K, 8) = ArrN(N, 2)
            If ArrN(N, 3) >= Xuat Then
                dArr(K, 9) = Xuat
                ArrN(N, 3) = ArrN(N, 3) - Xuat
                Exit For
            Else
                dArr(K, 9) = ArrN(N, 3)
                Xuat = Xuat - ArrN(N, 3)
                ArrN(N, 3) = 0
            End If
        End If
    Next N
Next I
'=================================== SL Nhap con lai'
For N = 1 To R2
    If ArrN(N, 3) > 0 Then
        K = K + 1
        dArr(K, 7) = ArrN(N, 1)
        dArr(K, 8) = ArrN(N, 2)
        dArr(K, 9) = ArrN(N, 3)
    End If
Next N
Sheets("GPE").Range("A7").Resize(10000, 9).ClearContents
Sheets("GPE").Range("A7").Resize(K, 9) = dArr
End Sub

 

[tocxuu]

Em xin chân thành cảm ơn anh @Maika8008 anh @HieuCD anh @Ba Tê anh @bebo021999
Cảm ơn sự giúp đỡ của tất cả mọi người.
Chúc mọi người cuối tuần vui vẻ.