Tính tổng theo nhiều điều kiện

[vulunktheky]

Chào anh chị và các bạn, mình có một đoạn code trước đây chạy dữ liệu đúng với yêu cầu lúc đó nhưng hiện tại có một vấn đề phát sinh là: khi 1 đơn hàng quét hệ thống 2 lần thì chỉ tính tổng số nhập kho từng size được ở lần quét đầu tiên, lần quét thứ 2 thì không tính tổng số nhập kho từng size được. mong anh chị và các bạn giúp đỡ.
Ví dụ như ở Line 1, đơn hàng và mã hàng được quét nhập kho 2 lần nhưng chỉ tính được ở lần quét đầu tiên.
xin cảm ơn anh chị.

 

[befaint]

một vấn đề phát sinh là: khi 1 đơn hàng quét hệ thống 2 lần thì chỉ tính tổng số nhập kho từng size được ở lần quét đầu tiên, lần quét thứ 2 thì không tính tổng số nhập kho từng size được.
Ví dụ như ở Line 1, đơn hàng và mã hàng được quét nhập kho 2 lần nhưng chỉ tính được ở lần quét đầu tiên.

Thấy mình kể chuyện không à.
Túm lại cuối cùng mình cần tính hết hay chỉ tính lần đầu tiên?

 

[vulunktheky]

Thấy mình kể chuyện không à.
Túm lại cuối cùng mình cần tính hết hay chỉ tính lần đầu tiên?

tính tổng hết số lượng nhập kho luôn á anh.

 

[HieuCD]

Chào anh chị và các bạn, mình có một đoạn code trước đây chạy dữ liệu đúng với yêu cầu lúc đó nhưng hiện tại có một vấn đề phát sinh là: khi 1 đơn hàng quét hệ thống 2 lần thì chỉ tính tổng số nhập kho từng size được ở lần quét đầu tiên, lần quét thứ 2 thì không tính tổng số nhập kho từng size được. mong anh chị và các bạn giúp đỡ.
Ví dụ như ở Line 1, đơn hàng và mã hàng được quét nhập kho 2 lần nhưng chỉ tính được ở lần quét đầu tiên.
xin cảm ơn anh chị.

Chỉnh tí

Sub laydulieu()
  Dim arr, arr1, lr As Long, i&, r&, j As Integer, dk As String, dic As Object, a As Long, dks As String
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("DATA")
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     If lr < 4 Then Exit Sub
     arr = .Range("A2:W" & lr).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To 3)
  End With
 
  For i = 3 To UBound(arr, 1)
    If arr(i, 1) <> "Line Line Line" And arr(i, 1) <> Empty Then
        dks = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3)
        If Not dic.exists(dks) Then
            a = a + 1
            dic.Add dks, a
            arr1(a, 1) = arr(i, 1): arr1(a, 2) = arr(i, 2): arr1(a, 3) = arr(i, 3)
        End If
        r = dic.Item(dks)
        For j = 4 To UBound(arr, 2)
          If arr(i - 1, j) <> Empty Then
            dk = dks & "#" & arr(i - 1, j)
            dic.Item(dk) = dic.Item(dk) + arr(i, j)
          End If
        Next j
    End If
  Next i
  With Sheets("REPORT")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr > 3 Then .Range("B3:AX" & lr).ClearContents
     If a Then .Range("B3").Resize(a, 3).Value = arr1
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     arr = .Range("B1:AX" & lr).Value
     For i = 1 To UBound(arr, 1)
         For j = 4 To UBound(arr, 2)
            dk = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3) & "#" & arr(1, j)
           If dic.exists(dk) Then
              arr(i, j) = dic.Item(dk)
           End If
       Next j
     Next i
      .Range("B1:AX" & lr).Value = arr
  End With
End Sub

 

[vulunktheky]

Chỉnh tí

Sub laydulieu()
  Dim arr, arr1, lr As Long, i&, r&, j As Integer, dk As String, dic As Object, a As Long, dks As String
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("DATA")
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     If lr < 4 Then Exit Sub
     arr = .Range("A2:W" & lr).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To 3)
  End With

  For i = 3 To UBound(arr, 1)
    If arr(i, 1) <> "Line Line Line" And arr(i, 1) <> Empty Then
        dks = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3)
        If Not dic.exists(dks) Then
            a = a + 1
            dic.Add dks, a
            arr1(a, 1) = arr(i, 1): arr1(a, 2) = arr(i, 2): arr1(a, 3) = arr(i, 3)
        End If
        r = dic.Item(dks)
        For j = 4 To UBound(arr, 2)
          If arr(i - 1, j) <> Empty Then
            dk = dks & "#" & arr(i - 1, j)
            dic.Item(dk) = dic.Item(dk) + arr(i, j)
          End If
        Next j
    End If
  Next i
  With Sheets("REPORT")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr > 3 Then .Range("B3:AX" & lr).ClearContents
     If a Then .Range("B3").Resize(a, 3).Value = arr1
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     arr = .Range("B1:AX" & lr).Value
     For i = 1 To UBound(arr, 1)
         For j = 4 To UBound(arr, 2)
            dk = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3) & "#" & arr(1, j)
           If dic.exists(dk) Then
              arr(i, j) = dic.Item(dk)
           End If
       Next j
     Next i
      .Range("B1:AX" & lr).Value = arr
  End With
End Sub

em cảm ơn anh nhiều