Đặt giúp mình công thức sắp xếp và tính tổng các mã vật tư

[thuytien7667]

Thân gửi các bạn. Mình có bảng vật tư nhưng mỗi ngày 1 loại vật tư, các bạn giup mình công thức sắp xếp các loại vật tư giống nhau thì để cạnh nhau để dễ cộng tổng ạ. Mình tự cut và Paste các mã vật tư giống nhau vào cạnh nhau, nhưng làm thủ công thế dễ sai sót lắm ạ. Các bạn giup mình với nha, cảm ơn nhiều.

 

[HieuCD]

Thân gửi các bạn. Mình có bảng vật tư nhưng mỗi ngày 1 loại vật tư, các bạn giup mình công thức sắp xếp các loại vật tư giống nhau thì để cạnh nhau để dễ cộng tổng ạ. Mình tự cut và Paste các mã vật tư giống nhau vào cạnh nhau, nhưng làm thủ công thế dễ sai sót lắm ạ. Các bạn giup mình với nha, cảm ơn nhiều.

Công thức rất rối, dùng code VBA
Kết quả ở sheet Kq

Sub XepNVL()
  Dim sArr(), Res(), iKey
  Dim i&, k&, ik&, id&, j&, n&, r&, sRow&, sCol&
 
  With Sheets("XUAT 06 12112011")
    sArr = .Range("A3:K" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  sRow = UBound(sArr):      sCol = UBound(sArr, 2)
  With CreateObject("scripting.dictionary")
    For i = 1 To sRow
      iKey = sArr(i, 5)
      If Len(iKey) Then
        If .exists(iKey) = False Then k = k + 2 Else k = k + 1
        .Item(iKey) = .Item(iKey) & "," & i
      End If
    Next i
    ReDim Res(1 To k, 1 To sCol)
    k = 0
    For Each iKey In .keys
      k = k + 1
      id = k
      s = Split(.Item(iKey), ",")
      n = UBound(s)
      For r = 1 To n
        k = k + 1
        ik = CLng(s(r))
        For j = 1 To sCol
          Res(k, j) = sArr(ik, j)
        Next j
        Res(id, 7) = Res(id, 7) + sArr(ik, 7)
        Res(id, 9) = Res(id, 9) + sArr(ik, 9)
      Next r
    Next
  End With
  With Sheets("Kq")
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i > 2 Then .Range("A3:K" & i).ClearContents
    .Range("A3").Resize(k, sCol) = Res
  End With
End Sub

 

[ppc0312]

ngôn ngữ là để diễn giải, giờ họ lại thích tắt

 

[AnhThu-1976]

dùng code VBA

Nếu được nhờ bạn HieuCD giải thích sơ lược code trên ạ
Cảm ơn bạn trước!

 

[thuytien7667]

Công thức rất rối, dùng code VBA
Kết quả ở sheet Kq

Sub XepNVL()
  Dim sArr(), Res(), iKey
  Dim i&, k&, ik&, id&, j&, n&, r&, sRow&, sCol&

  With Sheets("XUAT 06 12112011")
    sArr = .Range("A3:K" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  sRow = UBound(sArr):      sCol = UBound(sArr, 2)
  With CreateObject("scripting.dictionary")
    For i = 1 To sRow
      iKey = sArr(i, 5)
      If Len(iKey) Then
        If .exists(iKey) = False Then k = k + 2 Else k = k + 1
        .Item(iKey) = .Item(iKey) & "," & i
      End If
    Next i
    ReDim Res(1 To k, 1 To sCol)
    k = 0
    For Each iKey In .keys
      k = k + 1
      id = k
      s = Split(.Item(iKey), ",")
      n = UBound(s)
      For r = 1 To n
        k = k + 1
        ik = CLng(s(r))
        For j = 1 To sCol
          Res(k, j) = sArr(ik, j)
        Next j
        Res(id, 7) = Res(id, 7) + sArr(ik, 7)
        Res(id, 9) = Res(id, 9) + sArr(ik, 9)
      Next r
    Next
  End With
  With Sheets("Kq")
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i > 2 Then .Range("A3:K" & i).ClearContents
    .Range("A3").Resize(k, sCol) = Res
  End With
End Sub

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

cảm ơn bạn Hiếu nhiều.

 

[HieuCD]

Nếu được nhờ bạn HieuCD giải thích sơ lược code trên ạ
Cảm ơn bạn trước!

Hy vọng bạn hiểu ghi chú

Sub XepNVL()
  Dim sArr(), Res(), iKey
  Dim i&, k&, ik&, id&, j&, n&, r&, sRow&, sCol&
 
  With Sheets("XUAT 06 12112011")
    'gán mang du lieu
    sArr = .Range("A3:K" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  sRow = UBound(sArr) 'So dong du lieu
  sCol = UBound(sArr, 2) 'So cot du lieu
  With CreateObject("scripting.dictionary")
    For i = 1 To sRow
      iKey = sArr(i, 5)
      If Len(iKey) Then
        'Dem so dong ket qua, moi loai vat tu them 1 dong tong cong (k=k+2)
        If .exists(iKey) = False Then k = k + 2 Else k = k + 1
        .Item(iKey) = .Item(iKey) & "," & i 'gán các thu tu dong cua mot loai vat tu vào Item
      End If
    Next i
    ReDim Res(1 To k, 1 To sCol)
    k = 0
    For Each iKey In .keys
      k = k + 1 ' dong tong cong
      id = k ' dong tong cong
      s = Split(.Item(iKey), ",")
      n = UBound(s)
      For r = 1 To n
        k = k + 1 ' dong du lieu ket qua
        ik = CLng(s(r)) ' thu tu dong cua mang sArr
        For j = 1 To sCol
          Res(k, j) = sArr(ik, j)
        Next j
        Res(id, 7) = Res(id, 7) + sArr(ik, 7) ' tính dong tong cong cot So_Luong
        Res(id, 9) = Res(id, 9) + sArr(ik, 9) ' tính dong tong cong cot Tien
      Next r
    Next
  End With
  With Sheets("Kq")
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i > 2 Then .Range("A3:K" & i).ClearContents
    .Range("A3").Resize(k, sCol) = Res
  End With
End Sub