Truy vấn dữ liệu theo điều kiện

[kokano90]

Chào các thầy cô.
Em muốn nhờ thầy cô giúp em bài này ạ.
Hiện tại em có file đính kèm
Em muốn lấy dữ liệu từ các Time và NLSX vào sheet Form theo điều kiện:

Do hiện tại đang làm thủ công. Mất nhiều thời gian quá. Nên Nhờ các thầy cô giúp đỡ
Các thông tin cần em đã ghi chú tại comment.
Em xin cám ơn nhiều ạ

 

[XuanThanh]

Chào các thầy cô.
Em muốn nhờ thầy cô giúp em bài này ạ.
Hiện tại em có file đính kèm
Em muốn lấy dữ liệu từ các Time và NLSX vào sheet Form theo điều kiện:
View attachment 228537
Do hiện tại đang làm thủ công. Mất nhiều thời gian quá. Nên Nhờ các thầy cô giúp đỡ
Các thông tin cần em đã ghi chú tại comment.
Em xin cám ơn nhiều ạ

Trong Sheet NLSX làm gì có khung giờ sản phẩm mà theo dõi tổng hợp?

 

[kokano90]

Trong Sheet NLSX làm gì có khung giờ sản phẩm mà theo dõi tổng hợp?

Cái sheets NLSX ấy em chỉ muốn lấ dữ liệu vào cột B thôi ạ. Nếu cần. Em sẽ thiết kế lại sheets đó ạ

 

[HieuCD]

Chào các thầy cô.
Em muốn nhờ thầy cô giúp em bài này ạ.
Hiện tại em có file đính kèm
Em muốn lấy dữ liệu từ các Time và NLSX vào sheet Form theo điều kiện:
View attachment 228537
Do hiện tại đang làm thủ công. Mất nhiều thời gian quá. Nên Nhờ các thầy cô giúp đỡ
Các thông tin cần em đã ghi chú tại comment.
Em xin cám ơn nhiều ạ

Tạo sự kiện, thay đổi ô B5 hoặc E5 sẽ chạy code

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim aTime()
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  If Target.Address(0, 0) = "B5" Then
    Range("A8:B23").ClearContents
    If Len(Target.Value) > 0 Then Call ThoiGian(aTime, Target.Value)
  ElseIf Target.Address(0, 0) = "E5" Then
    Range("B8:B23").ClearContents
    aTime = Range("A8:A23").Value
    If Len(Target.Value) > 0 Then Call MucTieu(aTime, Target.Value)
  End If
  Application.ScreenUpdating = True
  Application.EnableEvents = tue
End Sub

Private Sub MucTieu(aTime, ByVal tmp As String)
  Dim Res()
  Dim eRow&, eCol&, sRow&, i&, NL, d, t
  With Sheets("NLSX")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To eRow
      If .Cells(i, 1).Value = tmp Then
        NL = .Cells(i, 2).Value
        Exit For
      End If
    Next i
  End With
  If Len(NL) = 0 Then Exit Sub
  sRow = UBound(aTime)
  ReDim Res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    If InStr(1, aTime(i, 1), "~") > 0 Then
      s = Split(aTime(i, 1), "~")
      d = NL * (CDate(s(1)) - CDate(s(0))) * 24
      t = t + d
      Res(i, 1) = d & Chr(10) & "  " & t
    End If
  Next i
  Range("B8").Resize(sRow) = Res
End Sub

Private Sub ThoiGian(aTime, ByVal tmp As String)
  Dim eRow&, eCol&, j&
  With Sheets("Time")
    eCol = .Cells(3, 1000).End(xlToLeft).Column
    For j = 2 To eCol
      If .Cells(3, j).Value = tmp Then
        eRow = .Cells(Rows.Count, j).End(xlUp).Row
        If eRow > 3 Then
          aTime = .Range(.Cells(4, j), .Cells(eRow, j)).Value
          Range("A8").Resize(eRow - 3).Value = aTime
          Exit For
        End If
      End If
    Next j
  End With
  If Len(Range("E5").Value) > 0 Then
    Call MucTieu(aTime, Range("E5").Value)
  End If
End Sub

 

[kokano90]

Tạo sự kiện, thay đổi ô B5 hoặc E5 sẽ chạy code

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim aTime()
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  If Target.Address(0, 0) = "B5" Then
    Range("A8:B23").ClearContents
    If Len(Target.Value) > 0 Then Call ThoiGian(aTime, Target.Value)
  ElseIf Target.Address(0, 0) = "E5" Then
    Range("B8:B23").ClearContents
    aTime = Range("A8:A23").Value
    If Len(Target.Value) > 0 Then Call MucTieu(aTime, Target.Value)
  End If
  Application.ScreenUpdating = True
  Application.EnableEvents = tue
End Sub

Private Sub MucTieu(aTime, ByVal tmp As String)
  Dim Res()
  Dim eRow&, eCol&, sRow&, i&, NL, d, t
  With Sheets("NLSX")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To eRow
      If .Cells(i, 1).Value = tmp Then
        NL = .Cells(i, 2).Value
        Exit For
      End If
    Next i
  End With
  If Len(NL) = 0 Then Exit Sub
  sRow = UBound(aTime)
  ReDim Res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    If InStr(1, aTime(i, 1), "~") > 0 Then
      s = Split(aTime(i, 1), "~")
      d = NL * (CDate(s(1)) - CDate(s(0))) * 24
      t = t + d
      Res(i, 1) = d & Chr(10) & "  " & t
    End If
  Next i
  Range("B8").Resize(sRow) = Res
End Sub

Private Sub ThoiGian(aTime, ByVal tmp As String)
  Dim eRow&, eCol&, j&
  With Sheets("Time")
    eCol = .Cells(3, 1000).End(xlToLeft).Column
    For j = 2 To eCol
      If .Cells(3, j).Value = tmp Then
        eRow = .Cells(Rows.Count, j).End(xlUp).Row
        If eRow > 3 Then
          aTime = .Range(.Cells(4, j), .Cells(eRow, j)).Value
          Range("A8").Resize(eRow - 3).Value = aTime
          Exit For
        End If
      End If
    Next j
  End With
  If Len(Range("E5").Value) > 0 Then
    Call MucTieu(aTime, Range("E5").Value)
  End If
End Sub

Cám ơn thầy rất nhiều. em thấy chạy rồi ạ. Xin cho em thêm 1 chút thời gian test thử coi có lỗi gì không ạ. có cách nào làm tròn số ở cột mục tiêu trả về không có số thập phân không thế ạ.
Và khi mình chọn giờ là Ca3 trở đi ấy ạ. em chưa hiểu sao nó lại ra số âm. có cách nào khắc phục cái đó không ạ?

 

[HieuCD]

Cám ơn thầy rất nhiều. em thấy chạy rồi ạ. Xin cho em thêm 1 chút thời gian test thử coi có lỗi gì không ạ. có cách nào làm tròn số ở cột mục tiêu trả về không có số thập phân không thế ạ.
Và khi mình chọn giờ là Ca3 trở đi ấy ạ. em chưa hiểu sao nó lại ra số âm. có cách nào khắc phục cái đó không ạ?

Mình không để ý thời gian Ca 3, Chỉnh lại 2 Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim aTime()
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  If Target.Address(0, 0) = "B5" Then
    Range("A8:B23").ClearContents
    If Len(Target.Value) > 0 Then Call ThoiGian(aTime, Target.Value)
  ElseIf Target.Address(0, 0) = "E5" Then
    Range("B8:B23").ClearContents
    aTime = Range("A8:A23").Value
    If Len(Target.Value) > 0 Then Call MucTieu(aTime, Target.Value)
  End If
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub

Private Sub MucTieu(aTime, ByVal tmp As String)
  Dim Res(), fTime, eTime
  Dim eRow&, sRow&, i&, NL, d, t
  With Sheets("NLSX")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To eRow
      If .Cells(i, 1).Value = tmp Then
        NL = .Cells(i, 2).Value
        Exit For
      End If
    Next i
  End With
  If Len(NL) = 0 Then Exit Sub
  sRow = UBound(aTime)
  ReDim Res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    If InStr(1, aTime(i, 1), "~") > 0 Then
      s = Split(aTime(i, 1), "~")
      fTime = CDate(s(0)) * 24
      eTime = CDate(s(1)) * 24
      If eTime >= fTime Then
        d = NL * (eTime - fTime)
      Else
        d = NL * (24 + eTime - fTime)
      End If
      t = t + d
      Res(i, 1) = Round(d, 2) & Chr(10) & "  " & t
    End If
  Next i
  Range("B8").Resize(sRow) = Res
End Sub

 

[kokano90]

Cám ơn thầy ạ. Lần này em thấy nó ra đúng rồi ạ. Để em test thử xem có lỗi gì rồi em sẽ phản hồi ạ