Hàm xử lý dữ liệu

[kyo37]

Dear cả nhà

Em có file nhật ký sản xuất dưới xưởng từ Cột H đến Cột FC bên dưới xưởng đang liệt kê theo hàng ngang thứ tự từ ngày 1 đến ngày 30 or 31 trong từng tháng;dòng 3 thể hiện số tháng; dòng 4 là số ngày trong tháng.
Cột A,B là mã sản phẩm;C là màu; D số lượng...
Bài toán đặt ra của em có cách nào bố trí lại dữ liệu ngày tháng theo dạng hàng dọc và số lượng đã thống kê vẫn giữ nguyên được như dữ liệu ban đầu bố trí theo hàng ngang.
Ví dụ: Cut 27524 ngày 07/01 (đối chiếu cột H dòng 3, dòng 4 nối lại là ngày tháng) số lượng là 330. Ngày 08/01 vẫn mã trên Cut 27524 ngày 08/01 số lượng là 600. Ngày 09/01 vẫn Cut 27524 số lượng là 600... Có cách nào khi bố trí lại dữ liệu ngày tháng theo Cột cố định: 07/01/2019;08/01/2019, 09/01/2019... số lượng 330,600,600 ở các cột H;I;J đối với mã trên cũng tự điền chính xác theo ngày phát sinh như ví dụ.
Sheet Kết quả là Kết quả em mong muốn.Có phương án nào xử lý 1 lần cho cả Bảng dữ liệu và cho kết quả luông không ạ?
Em cảm ơn nhiều ạ.

 

[HieuCD]

Dear cả nhà

Em có file nhật ký sản xuất dưới xưởng từ Cột H đến Cột FC bên dưới xưởng đang liệt kê theo hàng ngang thứ tự từ ngày 1 đến ngày 30 or 31 trong từng tháng;dòng 3 thể hiện số tháng; dòng 4 là số ngày trong tháng.
Cột A,B là mã sản phẩm;C là màu; D số lượng...
Bài toán đặt ra của em có cách nào bố trí lại dữ liệu ngày tháng theo dạng hàng dọc và số lượng đã thống kê vẫn giữ nguyên được như dữ liệu ban đầu bố trí theo hàng ngang.
Ví dụ: Cut 27524 ngày 07/01 (đối chiếu cột H dòng 3, dòng 4 nối lại là ngày tháng) số lượng là 330. Ngày 08/01 vẫn mã trên Cut 27524 ngày 08/01 số lượng là 600. Ngày 09/01 vẫn Cut 27524 số lượng là 600... Có cách nào khi bố trí lại dữ liệu ngày tháng theo Cột cố định: 07/01/2019;08/01/2019, 09/01/2019... số lượng 330,600,600 ở các cột H;I;J đối với mã trên cũng tự điền chính xác theo ngày phát sinh như ví dụ.
Sheet Kết quả là Kết quả em mong muốn.Có phương án nào xử lý 1 lần cho cả Bảng dữ liệu và cho kết quả luông không ạ?
Em cảm ơn nhiều ạ.

Chạy code VBA

Sub GPE()
  Dim sArr(), tArr(), Res(), cArr(1 To 5), tdBln As Boolean
  Dim i As Long, sR As Long, k As Long, j As Long, sC As Long, c As Long

  With Sheets("Sheet1")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    j = .Cells(4, Columns.Count - 1).End(xlToLeft).Column
    sArr = .Range("A3:E" & i).Value
    tArr = .Range("H3", .Cells(i, j)).Value
    sR = UBound(tArr, 1):   sC = UBound(tArr, 2)
    i = Application.Count(.Range("H5", .Cells(i, j)))
  End With
 
  ReDim Res(1 To i, 1 To sC)
  For i = 3 To sR
    For c = 1 To 5
      cArr(c) = sArr(i, c)
    Next c
    tdBln = False
    For j = 1 To sC
      If Len(tArr(i, j)) > 0 And IsNumeric(tArr(i, j)) Then
        k = k + 1
        If tdBln = False Then
          For c = 1 To 5
            Res(k, c) = cArr(c)
          Next c
          tdBln = True
        End If
        Res(k, 6) = tArr(i, j)
        Res(k, 7) = tArr(2, j)
        Res(k, 8) = tArr(1, j)
      End If
    Next j
  Next i
 
  With Sheets("KetQuaMongMuon")
    i = .Range("F" & Rows.Count).End(xlUp).Row
    If i > 2 Then .Range("A3:H" & i).Clear
    If k Then
      .Range("A3:H3").Resize(k) = Res
      .Range("A3:H3").Resize(k).Borders.LineStyle = 1
    End If
  End With
End Sub

 

[kyo37]

Chạy code VBA

Sub GPE()
  Dim sArr(), tArr(), Res(), cArr(1 To 5), tdBln As Boolean
  Dim i As Long, sR As Long, k As Long, j As Long, sC As Long, c As Long

  With Sheets("Sheet1")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    j = .Cells(4, Columns.Count - 1).End(xlToLeft).Column
    sArr = .Range("A3:E" & i).Value
    tArr = .Range("H3", .Cells(i, j)).Value
    sR = UBound(tArr, 1):   sC = UBound(tArr, 2)
    i = Application.Count(.Range("H5", .Cells(i, j)))
  End With

  ReDim Res(1 To i, 1 To sC)
  For i = 3 To sR
    For c = 1 To 5
      cArr(c) = sArr(i, c)
    Next c
    tdBln = False
    For j = 1 To sC
      If Len(tArr(i, j)) > 0 And IsNumeric(tArr(i, j)) Then
        k = k + 1
        If tdBln = False Then
          For c = 1 To 5
            Res(k, c) = cArr(c)
          Next c
          tdBln = True
        End If
        Res(k, 6) = tArr(i, j)
        Res(k, 7) = tArr(2, j)
        Res(k, 8) = tArr(1, j)
      End If
    Next j
  Next i

  With Sheets("KetQuaMongMuon")
    i = .Range("F" & Rows.Count).End(xlUp).Row
    If i > 2 Then .Range("A3:H" & i).Clear
    If k Then
      .Range("A3:H3").Resize(k) = Res
      .Range("A3:H3").Resize(k).Borders.LineStyle = 1
    End If
  End With
End Sub

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