Truy vấn dữ liệu theo điều kiện (1 người xem)

kokano90 · 18/11/19

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 · 18/11/19

kokano90 đã viết:
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 · 18/11/19

XuanThanh đã viết:
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 · 18/11/19

kokano90 đã viết:
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

Mã:

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 · 19/11/19

HieuCD đã viết:

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

Mã:

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 · 19/11/19

kokano90 đã viết:
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

Mã:

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 · 19/11/19

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 ạ

Truy vấn dữ liệu theo điều kiện (1 người xem)

Người dùng đang xem chủ đề này

kokano90

Thành viên hoạt động

File đính kèm

XuanThanh

Thành viên thường trực

kokano90

Thành viên hoạt động

HieuCD

Chuyên gia GPE

File đính kèm

kokano90

Thành viên hoạt động

HieuCD

Chuyên gia GPE

kokano90

Thành viên hoạt động

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

Thời gian đếm ngược.