Nhờ cả nhà giúp code VBA tìm khoảng thời gian giao nhau giữa 3 khoảng thời gian cho trước

Liên hệ QC

tangoctuan

Thành viên hoạt động
Tham gia
22/4/08
Bài viết
153
Được thích
19
Em có 3 khoảng thời gian (có thể trùng hoặc khác nhau) như trong file gửi kèm, và muốn tìm khoảng giao trùng nhau giữa 3 cặp này là bao nhiêu lâu (theo đơn vị phút).

Kính nhờ các bác hỗ trợ giúp. Em xin cảm ơn!
 

File đính kèm

  • Tim khoang thoi gian giao nhau.xlsb
    9.5 KB · Đọc: 22
Em có 3 khoảng thời gian (có thể trùng hoặc khác nhau) như trong file gửi kèm, và muốn tìm khoảng giao trùng nhau giữa 3 cặp này là bao nhiêu lâu (theo đơn vị phút).

Kính nhờ các bác hỗ trợ giúp. Em xin cảm ơn!
Muốn tính số phút giữa 2 thời điểm thì lấy (thời gian sau - thời gian trước) x 1440 sẽ ra số phút
 
Em có 3 khoảng thời gian (có thể trùng hoặc khác nhau) như trong file gửi kèm, và muốn tìm khoảng giao trùng nhau giữa 3 cặp này là bao nhiêu lâu (theo đơn vị phút).

Kính nhờ các bác hỗ trợ giúp. Em xin cảm ơn!
Dữ liệu trong file không phải là Date, không làm được.
 
Muốn tính số phút giữa 2 thời điểm thì lấy (thời gian sau - thời gian trước) x 1440 sẽ ra số phút
vâng cái đó thì em cũng biết, nhưng cái chính là tìm khoảng thời gian trùng giao nhau giữa 3 cặp thời điểm thì mới là khó với em ấy bác.
Dữ liệu trong file không phải là Date, không làm được.
dữ liệu hệ thống xuất ra theo định dạng như vậy rồi
 
vâng cái đó thì em cũng biết, nhưng cái chính là tìm khoảng thời gian trùng giao nhau giữa 3 cặp thời điểm thì mới là khó với em ấy bác.

dữ liệu hệ thống xuất ra theo định dạng như vậy rồi
Thử code này, chưa kiểm tra kỹ:
Mã:
Option Explicit

Sub NT()
Dim Arr(), Res(), fMax As Double, tMin As Double, I As Long, U1 As Long, U2 As Long, J As Long
Dim fDate As Double, tDate As Double
Arr = Sheets("Sheet1").Range("A2:F" & Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row).Value
U1 = UBound(Arr, 1): U2 = UBound(Arr, 2)
ReDim Res(1 To U1, 1 To 1)
For I = 1 To U1
    tMin = 10 ^ 10: fMax = 0
    For J = 1 To U2 Step 2
    fDate = CDbl(CDate(Arr(I, J))): tDate = CDbl(CDate(Arr(I, J + 1)))
        If fDate > 0 And tDate > 0 Then
            If fDate > fMax Then fMax = fDate
            If tDate < tMin Then tMin = tDate
        End If
    Next
    If tMin > fMax And fMax > 0 Then
        Res(I, 1) = (tMin - fMax) * 1440
    End If
Next
Sheets("Sheet1").Range("G2").Resize(U1, 1) = Res
End Sub
 
Em thử trên máy em thấy ra kết quả bình thường, em không rõ máy khác định dạng khác nó sẽ thế nào nữa
Ví dụ: 12/04/2021 16:23:00 làm sao biết là tháng 12 hay tháng 04?

Hệ thống định dạng mm/dd thì trả về tháng 12, nếu dd/mm thì kết quả trả về tháng 04.

Viết một function getDateTime(byval strDateTime as String) as Double xem nào.
 
Viết một function getDateTime(byval strDateTime as String) as Double xem nào.
Đoạn này em vẫn chưa hình dung được, nếu nhìn bằng mắt không biết được text xuất ra từ phần mềm dạng nào, thì làm sao đưa nó về giá trị double được . Anh gợi ý em thuật toán với
 
Đoạn này em vẫn chưa hình dung được, nếu nhìn bằng mắt không biết được text xuất ra từ phần mềm dạng nào, thì làm sao đưa nó về giá trị double được . Anh gợi ý em thuật toán với
Cái DateTime trong file của họ là chuỗi mà: mm/dd/yyyy hh:MM:ss (xác nhận lại với chủ thớt).

Giờ xử lý chuỗi thôi. Rồi dùng hàm DateSerial(), TimeSerial().
 
Cái DateTime trong file của họ là chuỗi mà: mm/dd/yyyy hh:MM:ss (xác nhận lại với chủ thớt).
Cái này thì chắc chắn rồi không cần xác nhận đâu anh :D
Nãy em thắc mắc không hiểu là vì em nghĩ có thuật toán nào đó nhận biết được dữ liệu đầu vào đang ở dạng nào, còn nếu nhìn vào dữ liệu xác định thì chắc hàm này em viết được, có điều giờ sắp hết giờ làm rồi :D
 
Em có 3 khoảng thời gian (có thể trùng hoặc khác nhau) như trong file gửi kèm, và muốn tìm khoảng giao trùng nhau giữa 3 cặp này là bao nhiêu lâu (theo đơn vị phút).

Kính nhờ các bác hỗ trợ giúp. Em xin cảm ơn!
3 khoảng tức là có tất cả 3 cặp (6) thời điểm. Giải theo kiểu giản đồ Venn thì ra chỗ giao giữa 2 cái chứ gì.
Nếu không cần theo thuật toán tối ưu thì chỉ việc viết một cái hàm tìm giao giữa 2 khoảng (4 thời điểm). Chạy hàm 2 lần thì được giao giữa 3 khoảng (6 thời điểm)

Function GiaoDiemTG(kh1, kh2)
' hàm tính thời gian giao giữa hai khoảng thời gian kh1 và kh2
' tham số kh1 : mảng 2 phần tử, kh1(0) = thời điểm bắt đầu; kh1(1) = thời điểm kết
' tham số kh2 : tương tự như kh1
' hàm trả về mảng khoảng thời gian giao, là mảng với dạng như kh1, kh2.
' nếu không có điểm giao thì trả về phần tử của mảng < 0
...
End Function

Để tính 3 khoảng bd1-kt1, bd2-kt2, bd3-kt3:
giao = GiaoDiemTG(GiaoDiemTG(Array(bd1, kt1), Array(bd2, kt2)), Array(bd1, kt3))
 
Dùng công thức:
=MIN(B2+0,D2+0,F2+0)-MAX(A2+0,C2+0,E2+0)
Định dạng time

Nếu ra số thập phân:
=(MIN(B2+0,D2+0,F2+0)-MAX(A2+0,C2+0,E2+0))*1440
Định dạng General
 
Thử code này, chưa kiểm tra kỹ:
Mã:
Option Explicit

Sub NT()
Dim Arr(), Res(), fMax As Double, tMin As Double, I As Long, U1 As Long, U2 As Long, J As Long
Dim fDate As Double, tDate As Double
Arr = Sheets("Sheet1").Range("A2:F" & Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row).Value
U1 = UBound(Arr, 1): U2 = UBound(Arr, 2)
ReDim Res(1 To U1, 1 To 1)
For I = 1 To U1
    tMin = 10 ^ 10: fMax = 0
    For J = 1 To U2 Step 2
    fDate = CDbl(CDate(Arr(I, J))): tDate = CDbl(CDate(Arr(I, J + 1)))
        If fDate > 0 And tDate > 0 Then
            If fDate > fMax Then fMax = fDate
            If tDate < tMin Then tMin = tDate
        End If
    Next
    If tMin > fMax And fMax > 0 Then
        Res(I, 1) = (tMin - fMax) * 1440
    End If
Next
Sheets("Sheet1").Range("G2").Resize(U1, 1) = Res
End Sub
vâng, định dạng trong này theo dạng mm/dd/yyyy hh:MM:ss bác ạ. Em chạy thử code của bác Nhattanktnn và kiểm tra thủ công thử một vài trường hợp thì chưa thấy có sai sót. Còn bác bảo chưa kiểm tra kỹ thì em cũng không biết phải kiểm tra lại như nào vì em chỉ biết copy code để chạy thôi ạ.
 
vâng, định dạng trong này theo dạng mm/dd/yyyy hh:MM:ss bác ạ. Em chạy thử code của bác Nhattanktnn và kiểm tra thủ công thử một vài trường hợp thì chưa thấy có sai sót. Còn bác bảo chưa kiểm tra kỹ thì em cũng không biết phải kiểm tra lại như nào vì em chỉ biết copy code để chạy thôi ạ.
Định dạng dữ liệu (format cell) không ảnh hưởng đến kết quả vì dữ liệu dạng text, các máy khai báo ngày tháng hệ thống khác nhau sẽ có kết quả khác nhau
Chuyển ngày tháng dạng text "dd/mm/yyyy hh:mm:ss" về dạng thời gian có thể dùng lệnh
= DateSerial(Mid(tmp, 7, 4), Mid(tmp, 4, 2), Mid(tmp, 1, 2)) + TimeValue(Mid(tmp, 12, 8))
Mượn code của bạn @Nhattanktnn
Mã:
Sub NT()
  Dim Arr(), Res() As Date, fMax As Double, tMin As Double, i As Long, U1 As Long, U2 As Long, J As Long
  Dim tmp, fDate As Double, tDate As Double
 
  Arr = Sheets("Sheet1").Range("A2:F" & Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row).Value
  U1 = UBound(Arr, 1): U2 = UBound(Arr, 2)
  ReDim Res(1 To U1, 1 To 1)
  For i = 1 To U1
    tMin = 10 ^ 10: fMax = 0
    For J = 1 To U2 Step 2
      tmp = Arr(i, J)
      If tmp <> 0 Then
        fDate = DateSerial(Mid(tmp, 7, 4), Mid(tmp, 4, 2), Mid(tmp, 1, 2)) + TimeValue(Mid(tmp, 12, 8))
      Else
        fDate = 0
      End If
      tmp = Arr(i, J + 1)
      If tmp <> 0 Then
        tDate = DateSerial(Mid(tmp, 7, 4), Mid(tmp, 4, 2), Mid(tmp, 1, 2)) + TimeValue(Mid(tmp, 12, 8))
      Else
        tDate = 0
      End If
      If fDate > fMax Then fMax = fDate
      If tDate < tMin Then tMin = tDate
    Next
    If tMin > fMax And fMax > 0 Then
      Res(i, 1) = (tMin - fMax) * 1440
    End If
  Next
  Sheets("Sheet1").Range("G2").Resize(U1, 1) = Res
End Sub
 
Web KT

Bài viết mới nhất

Back
Top Bottom