Hiển thị thông tin kết quả sản xuất

Ngocminh19 · 24/4/22

Em chào các anh chị em trên diễn đàn. Mong các anh chị giúp em vấn đề sau ạ.
Hiện tại do kế hoạch sản xuất bên em chạy nhiều line, Thông tin cần kiểm tra nhiều line khó xác định khi cần xem và tổng hợp
Em cảm ơn ! Chi tiết em xin gắn kèm file ạ

Mong muốn:
1.Dựa theo Sheet Data : Trình bày ra dữ liệu sắp xếp theo PRODUCT CODE (GỒM BOTTOM & TOP),theo từng LINE sản xuất,chi tiết model… cột B đến G
2.Chỉ thể hiện những Sản phẩm được sản xuất trong Time line (cột Total Prodction cộng có số lượng)
3. Trên em có để 2 Button Box : Xem tất cả số lượng là kiểm tra tất cả các sản phẩm chạy trên các LINE
- Kiểm tra từng line thì khi em nhập số line cần xem thì nhấn sẽ chỉ xem 1 line đó ạ
-Cột P bên sheet data là số lượng đã hoàn thành
4. Giúp em có thể kèm đều kiện :Khi em nhập khoảng thời gian muốn xem.
Nếu không có thời gian(hoặc nhập không đủ thời gian bắt đầu và thời gian kết thúc) thì mặc địch sẽ xem tất cả các ngày trong sheet data có ạ . Cột F

snow25 · 25/4/22

Ngocminh19 đã viết:
Em chào các anh chị em trên diễn đàn. Mong các anh chị giúp em vấn đề sau ạ.
Hiện tại do kế hoạch sản xuất bên em chạy nhiều line, Thông tin cần kiểm tra nhiều line khó xác định khi cần xem và tổng hợp
Em cảm ơn ! Chi tiết em xin gắn kèm file ạ

Mong muốn:
1.Dựa theo Sheet Data : Trình bày ra dữ liệu sắp xếp theo PRODUCT CODE (GỒM BOTTOM & TOP),theo từng LINE sản xuất,chi tiết model… cột B đến G
2.Chỉ thể hiện những Sản phẩm được sản xuất trong Time line (cột Total Prodction cộng có số lượng)
3. Trên em có để 2 Button Box : Xem tất cả số lượng là kiểm tra tất cả các sản phẩm chạy trên các LINE
- Kiểm tra từng line thì khi em nhập số line cần xem thì nhấn sẽ chỉ xem 1 line đó ạ
-Cột P bên sheet data là số lượng đã hoàn thành
4. Giúp em có thể kèm đều kiện :Khi em nhập khoảng thời gian muốn xem.
Nếu không có thời gian(hoặc nhập không đủ thời gian bắt đầu và thời gian kết thúc) thì mặc địch sẽ xem tất cả các ngày trong sheet data có ạ . Cột F

View attachment 274949

Thử code.

Mã:

Sub kiemtra()
    Dim i As Long, lr As Long, dic As Object, dk As String, ngaybd As Long, ngaykt As Long, lc As Long, ngay As Long, line As String
    Dim arr, kq, a As Long, b As Long, c As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("view plan")
         lc = .Cells(4, Columns.Count).End(xlToLeft).Column - 1
         If Len(.Range("h2").Value) = 0 Then ngaybd = 1 Else: ngaybd = .Range("h2").Value
         If Len(.Range("i2").Value) = 0 Then ngaybd = 10000 Else: ngaykt = .Range("i2").Value
         For i = 8 To lc
             ngay = CLng(.Cells(4, i).Value)
             dic.Item(ngay) = i - 1
         Next i
         line = .Range("E2").Value
    End With
    With Sheets("data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        arr = .Range("B3:P" & lr).Value
        ReDim kq(1 To UBound(arr), 1 To lc - 1)
        For i = 1 To UBound(arr)
           ' If Left(arr(i, 8), Len(arr(i, 8)) - 5) = line Then 'Nêu cân xem chi tiêt thi thêm dong này
            If CLng(arr(i, 5)) >= ngaybd And CLng(arr(i, 5)) <= ngaykt Then
               dk = arr(i, 1) & "#" & arr(i, 2) & arr(i, 3) & arr(i, 8)
               If Not dic.exists(dk) Then
                  a = a + 1
                  kq(a, 1) = a
                  kq(a, 2) = arr(i, 8)
                  kq(a, 3) = arr(i, 1)
                  kq(a, 4) = arr(i, 2)
                  kq(a, 5) = arr(i, 3)
                  dic.Add dk, a
               End If
                  b = dic.Item(dk)
                  ngay = CLng(arr(i, 5))
                  c = dic.Item(ngay)
                  If c Then
                     kq(b, 6) = kq(b, 6) + arr(i, 15)
                     kq(b, c) = kq(b, c) + arr(i, 15)
                  End If
         '  End If                                          'Nêu cân xem chi tiêt thi thêm dong này
           End If
       Next i
     End With
     With Sheets("view plan")
          lr = .Range("B" & Rows.Count).End(xlUp).Row
          If lr > 4 Then .Range("B5:B" & lr).Resize(, lc - 1).ClearContents
          If a Then .Range("B5").Resize(a, lc - 1).Value = kq
     End With
     Set dic = Nothing
End Sub

Ngocminh19 · 25/4/22

snow25 đã viết:

Thử code.

Mã:

Sub kiemtra()
    Dim i As Long, lr As Long, dic As Object, dk As String, ngaybd As Long, ngaykt As Long, lc As Long, ngay As Long, line As String
    Dim arr, kq, a As Long, b As Long, c As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("view plan")
         lc = .Cells(4, Columns.Count).End(xlToLeft).Column - 1
         If Len(.Range("h2").Value) = 0 Then ngaybd = 1 Else: ngaybd = .Range("h2").Value
         If Len(.Range("i2").Value) = 0 Then ngaybd = 10000 Else: ngaykt = .Range("i2").Value
         For i = 8 To lc
             ngay = CLng(.Cells(4, i).Value)
             dic.Item(ngay) = i - 1
         Next i
         line = .Range("E2").Value
    End With
    With Sheets("data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        arr = .Range("B3:P" & lr).Value
        ReDim kq(1 To UBound(arr), 1 To lc - 1)
        For i = 1 To UBound(arr)
           ' If Left(arr(i, 8), Len(arr(i, 8)) - 5) = line Then 'Nêu cân xem chi tiêt thi thêm dong này
            If CLng(arr(i, 5)) >= ngaybd And CLng(arr(i, 5)) <= ngaykt Then
               dk = arr(i, 1) & "#" & arr(i, 2) & arr(i, 3) & arr(i, 8)
               If Not dic.exists(dk) Then
                  a = a + 1
                  kq(a, 1) = a
                  kq(a, 2) = arr(i, 8)
                  kq(a, 3) = arr(i, 1)
                  kq(a, 4) = arr(i, 2)
                  kq(a, 5) = arr(i, 3)
                  dic.Add dk, a
               End If
                  b = dic.Item(dk)
                  ngay = CLng(arr(i, 5))
                  c = dic.Item(ngay)
                  If c Then
                     kq(b, 6) = kq(b, 6) + arr(i, 15)
                     kq(b, c) = kq(b, c) + arr(i, 15)
                  End If
         '  End If                                          'Nêu cân xem chi tiêt thi thêm dong này
           End If
       Next i
     End With
     With Sheets("view plan")
          lr = .Range("B" & Rows.Count).End(xlUp).Row
          If lr > 4 Then .Range("B5:B" & lr).Resize(, lc - 1).ClearContents
          If a Then .Range("B5").Resize(a, lc - 1).Value = kq
     End With
     Set dic = Nothing
End Sub

Em xin cảm ơn bác đã hỗ trợ ạ,Kết quả đúng như em mong muốn rồi.
Em xin nhờ bác giúp chỉnh lại giúp em phần ở cột Line,sẽ hiển thị hết 1-LINE rồi lần lượt sang 2-LINE VỚI Ạ
như hình em bên dưới ạ, em cảm ơn!

HieuCD · 25/4/22

Ngocminh19 đã viết:
Em chào các anh chị em trên diễn đàn. Mong các anh chị giúp em vấn đề sau ạ.
Hiện tại do kế hoạch sản xuất bên em chạy nhiều line, Thông tin cần kiểm tra nhiều line khó xác định khi cần xem và tổng hợp
Em cảm ơn ! Chi tiết em xin gắn kèm file ạ

Mong muốn:
1.Dựa theo Sheet Data : Trình bày ra dữ liệu sắp xếp theo PRODUCT CODE (GỒM BOTTOM & TOP),theo từng LINE sản xuất,chi tiết model… cột B đến G
2.Chỉ thể hiện những Sản phẩm được sản xuất trong Time line (cột Total Prodction cộng có số lượng)
3. Trên em có để 2 Button Box : Xem tất cả số lượng là kiểm tra tất cả các sản phẩm chạy trên các LINE
- Kiểm tra từng line thì khi em nhập số line cần xem thì nhấn sẽ chỉ xem 1 line đó ạ
-Cột P bên sheet data là số lượng đã hoàn thành
4. Giúp em có thể kèm đều kiện :Khi em nhập khoảng thời gian muốn xem.
Nếu không có thời gian(hoặc nhập không đủ thời gian bắt đầu và thời gian kết thúc) thì mặc địch sẽ xem tất cả các ngày trong sheet data có ạ . Cột F

View attachment 274949

Cột ngày tháng tự tính theo thời gian khai báo, nếu thiếu sẽ tính theo ngày đầu và ngày cuối của sheet data. Hai code tương tự nhau chỉ khác vài lệnh

Mã:

Option Explicit

Sub All_Line()
  Dim sArr(), res(), aNgay(), dic As Object, key$
  Dim sRow&, sCol&, i&, k&, ik&, j&, fDay&, eDay&, sDay&, line$
 
  With Sheets("View Plan")
    fDay = .Range("H2").Value
    eDay = .Range("I2").Value
  End With
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("Data")
    sArr = .Range("B3", .Range("P" & Rows.Count).End(xlUp)).Value
    sRow = UBound(sArr)
    If fDay = Empty Then fDay = Application.Min(.Range("F3").Resize(sRow))
    If eDay = Empty Then eDay = Application.Max(.Range("F3").Resize(sRow))
  End With
  sDay = eDay - fDay + 1 'So ngay
  sCol = sDay + 6 'So cot ket qua
  ReDim res(1 To sRow, 1 To sCol)
  ReDim aNgay(1 To 1, fDay To eDay)
  For i = 1 To sRow
    If sArr(i, 5) >= fDay And sArr(i, 5) <= eDay Then
      key = sArr(i, 3) & "|" & sArr(i, 8)
      If dic.exists(key) = False Then
        k = k + 1
        dic.Add key, k
        res(k, 2) = sArr(i, 8)
        res(k, 3) = sArr(i, 1)
        res(k, 4) = sArr(i, 2)
        res(k, 5) = sArr(i, 3)
      End If
      ik = dic.Item(key)
      res(ik, 6) = res(ik, 6) + sArr(i, 15) 'Cot Tong
      j = sArr(i, 5) - fDay + 7 'Cot Ngay
      res(ik, j) = res(ik, j) + sArr(i, 15)
    End If
  Next i
  For j = fDay To eDay
    aNgay(1, j) = j
  Next j
 
  With Sheets("View Plan")
    j = .Range("AAA4").End(xlToLeft).Column
    If j > 7 Then .Range("H4", Cells(4, j)).Clear
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5", Cells(i, j)).Clear
    If k Then
      .Range("H4").Resize(, sDay) = aNgay
      .Range("H4").Resize(, sDay).NumberFormat = "dd-mmm"
      .Range("B5").Resize(k, sCol) = res
      .Range("H5").Resize(k, sDay).NumberFormat = "#,###;;"
      .Range("B4").Resize(k + 1, sCol).Borders.LineStyle = 1
      .Range("B5").Resize(k, sCol).Sort .Range("C5"), 1, Header:=xlNo
      .Range("B5") = 1
      .Range("B5").Resize(k).DataSeries
    End If
  End With
End Sub

Sub One_Line()
  Dim sArr(), res(), aNgay(), dic As Object, key$
  Dim sRow&, sCol&, i&, k&, ik&, j&, fDay&, eDay&, sDay&, line$
 
  With Sheets("View Plan")
    line = .Range("E2").Value
    fDay = .Range("H2").Value
    eDay = .Range("I2").Value
  End With
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("Data")
    sArr = .Range("B3", .Range("P" & Rows.Count).End(xlUp)).Value
    sRow = UBound(sArr)
    If fDay = Empty Then fDay = Application.Min(.Range("F3").Resize(sRow))
    If eDay = Empty Then eDay = Application.Max(.Range("F3").Resize(sRow))
  End With
  sDay = eDay - fDay + 1 'So ngay
  sCol = sDay + 6 'So cot ket qua
  ReDim res(1 To sRow, 1 To sCol)
  ReDim aNgay(1 To 1, fDay To eDay)
  For i = 1 To sRow
    If Split(sArr(i, 8), "-")(0) = line Then
      If sArr(i, 5) >= fDay And sArr(i, 5) <= eDay Then
        key = sArr(i, 3) & "|" & sArr(i, 8)
        If dic.exists(key) = False Then
          k = k + 1
          dic.Add key, k
          res(k, 1) = k
          res(k, 2) = sArr(i, 8)
          res(k, 3) = sArr(i, 1)
          res(k, 4) = sArr(i, 2)
          res(k, 5) = sArr(i, 3)
        End If
        ik = dic.Item(key)
        res(ik, 6) = res(ik, 6) + sArr(i, 15) 'Cot Tong
        j = sArr(i, 5) - fDay + 7 'Cot Ngay
        res(ik, j) = res(ik, j) + sArr(i, 15)
      End If
    End If
  Next i
  For j = fDay To eDay
    aNgay(1, j) = j
  Next j
 
  With Sheets("View Plan")
    j = .Range("AAA4").End(xlToLeft).Column
    If j > 7 Then .Range("H4", Cells(4, j)).Clear
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5", Cells(i, j)).Clear
    If k Then
      .Range("H4").Resize(, sDay) = aNgay
      .Range("H4").Resize(, sDay).NumberFormat = "dd-mmm"
      .Range("B5").Resize(k, sCol) = res
      .Range("H5").Resize(k, sDay).NumberFormat = "#,###;;"
      .Range("B4").Resize(k + 1, sCol).Borders.LineStyle = 1
    End If
  End With
End Sub

snow25 · 25/4/22

Ngocminh19 đã viết:
Em xin cảm ơn bác đã hỗ trợ ạ,Kết quả đúng như em mong muốn rồi.
Em xin nhờ bác giúp chỉnh lại giúp em phần ở cột Line,sẽ hiển thị hết 1-LINE rồi lần lượt sang 2-LINE VỚI Ạ
như hình em bên dưới ạ, em cảm ơn!

View attachment 274971

Bạn sort lại dữ liệu Data theo từng line là được nhé.

Ngocminh19 · 25/4/22

HieuCD đã viết:

Cột ngày tháng tự tính theo thời gian khai báo, nếu thiếu sẽ tính theo ngày đầu và ngày cuối của sheet data. Hai code tương tự nhau chỉ khác vài lệnh

Mã:

Option Explicit

Sub All_Line()
  Dim sArr(), res(), aNgay(), dic As Object, key$
  Dim sRow&, sCol&, i&, k&, ik&, j&, fDay&, eDay&, sDay&, line$
 
  With Sheets("View Plan")
    fDay = .Range("H2").Value
    eDay = .Range("I2").Value
  End With
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("Data")
    sArr = .Range("B3", .Range("P" & Rows.Count).End(xlUp)).Value
    sRow = UBound(sArr)
    If fDay = Empty Then fDay = Application.Min(.Range("F3").Resize(sRow))
    If eDay = Empty Then eDay = Application.Max(.Range("F3").Resize(sRow))
  End With
  sDay = eDay - fDay + 1 'So ngay
  sCol = sDay + 6 'So cot ket qua
  ReDim res(1 To sRow, 1 To sCol)
  ReDim aNgay(1 To 1, fDay To eDay)
  For i = 1 To sRow
    If sArr(i, 5) >= fDay And sArr(i, 5) <= eDay Then
      key = sArr(i, 3) & "|" & sArr(i, 8)
      If dic.exists(key) = False Then
        k = k + 1
        dic.Add key, k
        res(k, 2) = sArr(i, 8)
        res(k, 3) = sArr(i, 1)
        res(k, 4) = sArr(i, 2)
        res(k, 5) = sArr(i, 3)
      End If
      ik = dic.Item(key)
      res(ik, 6) = res(ik, 6) + sArr(i, 15) 'Cot Tong
      j = sArr(i, 5) - fDay + 7 'Cot Ngay
      res(ik, j) = res(ik, j) + sArr(i, 15)
    End If
  Next i
  For j = fDay To eDay
    aNgay(1, j) = j
  Next j
 
  With Sheets("View Plan")
    j = .Range("AAA4").End(xlToLeft).Column
    If j > 7 Then .Range("H4", Cells(4, j)).Clear
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5", Cells(i, j)).Clear
    If k Then
      .Range("H4").Resize(, sDay) = aNgay
      .Range("H4").Resize(, sDay).NumberFormat = "dd-mmm"
      .Range("B5").Resize(k, sCol) = res
      .Range("H5").Resize(k, sDay).NumberFormat = "#,###;;"
      .Range("B4").Resize(k + 1, sCol).Borders.LineStyle = 1
      .Range("B5").Resize(k, sCol).Sort .Range("C5"), 1, Header:=xlNo
      .Range("B5") = 1
      .Range("B5").Resize(k).DataSeries
    End If
  End With
End Sub

Sub One_Line()
  Dim sArr(), res(), aNgay(), dic As Object, key$
  Dim sRow&, sCol&, i&, k&, ik&, j&, fDay&, eDay&, sDay&, line$
 
  With Sheets("View Plan")
    line = .Range("E2").Value
    fDay = .Range("H2").Value
    eDay = .Range("I2").Value
  End With
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("Data")
    sArr = .Range("B3", .Range("P" & Rows.Count).End(xlUp)).Value
    sRow = UBound(sArr)
    If fDay = Empty Then fDay = Application.Min(.Range("F3").Resize(sRow))
    If eDay = Empty Then eDay = Application.Max(.Range("F3").Resize(sRow))
  End With
  sDay = eDay - fDay + 1 'So ngay
  sCol = sDay + 6 'So cot ket qua
  ReDim res(1 To sRow, 1 To sCol)
  ReDim aNgay(1 To 1, fDay To eDay)
  For i = 1 To sRow
    If Split(sArr(i, 8), "-")(0) = line Then
      If sArr(i, 5) >= fDay And sArr(i, 5) <= eDay Then
        key = sArr(i, 3) & "|" & sArr(i, 8)
        If dic.exists(key) = False Then
          k = k + 1
          dic.Add key, k
          res(k, 1) = k
          res(k, 2) = sArr(i, 8)
          res(k, 3) = sArr(i, 1)
          res(k, 4) = sArr(i, 2)
          res(k, 5) = sArr(i, 3)
        End If
        ik = dic.Item(key)
        res(ik, 6) = res(ik, 6) + sArr(i, 15) 'Cot Tong
        j = sArr(i, 5) - fDay + 7 'Cot Ngay
        res(ik, j) = res(ik, j) + sArr(i, 15)
      End If
    End If
  Next i
  For j = fDay To eDay
    aNgay(1, j) = j
  Next j
 
  With Sheets("View Plan")
    j = .Range("AAA4").End(xlToLeft).Column
    If j > 7 Then .Range("H4", Cells(4, j)).Clear
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5", Cells(i, j)).Clear
    If k Then
      .Range("H4").Resize(, sDay) = aNgay
      .Range("H4").Resize(, sDay).NumberFormat = "dd-mmm"
      .Range("B5").Resize(k, sCol) = res
      .Range("H5").Resize(k, sDay).NumberFormat = "#,###;;"
      .Range("B4").Resize(k + 1, sCol).Borders.LineStyle = 1
    End If
  End With
End Sub

Dạ .Em cảm ơn bác giúp đỡ rất nhiều ạ. Đúng tất cả rồi ạ.

Bài đã được tự động gộp: 25/4/22

snow25 đã viết:
Bạn sort lại dữ liệu Data theo từng line là được nhé.

Vâng. em xin cảm ơn sự giúp đỡ của anh nhé.Em theo được rồi ạ

VetMini · 25/4/22

Bài này tại thớt rườm rà chứ chỉ cần phần lấy dữ liệu theo hạn ngày thôi. Các phần còn lại thuộc về Filter.

Tạo một sheet "Draft999" hidden.
Đặt sự kiện ở hai ô hạn ngày.
Khi có sự kiện:
{
Clear Draft999
Copy hai ô hạn ngày qua Draft999
Advanced Filter theo hạn ngày. Đặt kết quả ở Draft999. Sort kết quả theo line, sản phẩm, date.
Copy Usedrange vào array a
Tạo array b1(1 to số ngày từ bắt đầu đến kết thúc)
Tạo array b2(1 to UBound(a), 1 to 6 + UBound(b1))
Vòng lặp đặt các phần từ của b1 với các ngày tương ứng
Vòng lặp đọc a và bắt đầu dựng b2
- chi tiết sản phẩm nhét vào b2, cột B:F
- cột G, công thức Sum các cột còn lại
- các cột còn lại, cứ so đúng ngày ở b1 thì cộng vào cột tương ứng
Clear bảng cũ, chép b1 và b2 vào
}

Hiển thị thông tin kết quả sản xuất

Ngocminh19

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

File đính kèm

snow25

Thành viên gạo cội

Ngocminh19

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

HieuCD

Chuyên gia GPE

snow25

Thành viên gạo cội

Ngocminh19

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

VetMini

Ăn cùng góc phố

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