Xin hỗ trợ code tìm thời điểm nằm trong một khoảng thời gian cho trước

tangoctuan

Thành viên chính thức
Tham gia ngày
22 Tháng tư 2008
Bài viết
93
Được thích
10
Điểm
670
Tuổi
35
Mình đang cần xác định check xem một thời điểm cho trước có nằm trong (thuộc) một khoảng thời gian cho trước hay không mà chưa biết làm cách nào. Mình có mô tả kết quả mong muốn cụ thể như trong file gửi kèm. Nhờ các bác hỗ trợ giúp một đoạn vba xử lý giúp việc này với. Cảm ơn cả nhà!
File:
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,637
Được thích
2,536
Điểm
360
Mình đang cần xác định check xem một thời điểm cho trước có nằm trong (thuộc) một khoảng thời gian cho trước hay không mà chưa biết làm cách nào. Mình có mô tả kết quả mong muốn cụ thể như trong file gửi kèm. Nhờ các bác hỗ trợ giúp một đoạn vba xử lý giúp việc này với. Cảm ơn cả nhà!
File:
Cái này hàm làm được mà bạn.Bạn dùng hàm IF là được mà.Cần gì code VBA nhỉ.
 

VetMini

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
9,516
Được thích
11,399
Điểm
1,560
Bạn đưa cái mẫu hàm mình muốn lên đây.
Tôi sẽ cố giúp chèn thêm cái code để xét.
 

tangoctuan

Thành viên chính thức
Tham gia ngày
22 Tháng tư 2008
Bài viết
93
Được thích
10
Điểm
670
Tuổi
35
Cái này hàm làm được mà bạn.Bạn dùng hàm IF là được mà.Cần gì code VBA nhỉ.
Hàm If sẽ khá mất công nhưng quan trọng hơn là dữ liệu của mình khá lớn bạn à, nếu hàm thì e rằng không xử lý xuể. Dữ liệu hơn 500k dòng.
Bài đã được tự động gộp:

Cái này hàm làm được mà bạn.Bạn dùng hàm IF là được mà.Cần gì code VBA nhỉ.
Hàm If sẽ khá mất công nhưng quan trọng hơn là dữ liệu của mình khá lớn bạn à, nếu hàm thì e rằng không xử lý xuể. Dữ liệu hơn 500k dòng.
Bạn đưa cái mẫu hàm mình muốn lên đây.
Tôi sẽ cố giúp chèn thêm cái code để xét.
Cảm ơn bạn đã gợi ý. Nhưng thực sự mình còn chưa biết sẽ nên dùng hàm gì và như nào để xử lý bài toán này ấy kia. Vì dữ liệu phải dò tìm trên cả 1 tập mảng dữ liệu lớn nên mình chưa hiểu phải làm hàm gì.
Bạn mở giúp cái file mình đã gửi ấy, trong đó có mô tả rõ về bài toán của mình đang gặp phải nhờ hỗ trợ cách xử lý sao cho chính xác và
 
Lần chỉnh sửa cuối:

VetMini

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
9,516
Được thích
11,399
Điểm
1,560
Cảm ơn bạn đã gợi ý. Nhưng thực sự mình còn chưa biết sẽ nên dùng hàm gì và như nào để xử lý bài toán này ấy kia. ...
Tôi chỉ hỏi bạn cái mẫu, tức là bạn muốn cái dạng nó ra sao.
Và chuyện "dữ kiệu khủng" không có nghĩa lý gì với tôi cả. Theo tôi thì người làm việc với số dữ liệu khủng thì có bổn phận phải học mấy cái công cụ mới của Excel để quản lý chúng. Mấy cái Power's được đưa ra để làm việc với dữ liệu khủng. Không biết chúng là đi sau thời đại.
 

tangoctuan

Thành viên chính thức
Tham gia ngày
22 Tháng tư 2008
Bài viết
93
Được thích
10
Điểm
670
Tuổi
35
Tôi chỉ hỏi bạn cái mẫu, tức là bạn muốn cái dạng nó ra sao.
Và chuyện "dữ kiệu khủng" không có nghĩa lý gì với tôi cả. Theo tôi thì người làm việc với số dữ liệu khủng thì có bổn phận phải học mấy cái công cụ mới của Excel để quản lý chúng. Mấy cái Power's được đưa ra để làm việc với dữ liệu khủng. Không biết chúng là đi sau thời đại.
À trong file mình gửi cũng có cả mẫu rồi bạn.

Chỉ là fill vào cột kết quả mong muốn như vậy thôi. Bạn hướng dẫn giúp nhé.
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,637
Được thích
2,536
Điểm
360
À trong file mình gửi cũng có cả mẫu rồi bạn.

Chỉ là fill vào cột kết quả mong muốn như vậy thôi. Bạn hướng dẫn giúp nhé.
File hết thời hạn không tải được.Bạn đăng luôn file lên web này cũng được mà.
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,637
Được thích
2,536
Điểm
360
Bạn thử code này nhé.Bạn chỉnh lại dữ liệu cho chuẩn ngày tháng năm 2 sheets nhé.
Mã:
Sub kiemtra()
    Dim i As Long, lr As Long, arr, data, kq, dic As Object, a As Double, b As Double, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        data = .Range("B2:D" & lr).Value
        For i = 1 To UBound(data)
            dk = data(i, 1)
            If Not dic.exists(dk) Then
               dic.Add dk, Array(CDbl(data(i, 2)), CDbl(data(i, 3)))
            Else
               a = dic.Item(dk)(0)
               b = dic.Item(dk)(1)
               If a > CDbl(data(i, 2)) Then a = CDbl(data(i, 2))
               If b < CDbl(data(i, 3)) Then b = CDbl(data(i, 3))
               dic.Item(dk) = Array(a, b)
           End If
       Next i
    End With
    With Sheets("Check")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         arr = .Range("C2:D" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 1)
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             If dic.exists(dk) Then
                a = dic.Item(dk)(0)
                b = dic.Item(dk)(1)
                If CDbl(CDate(arr(i, 2))) >= a And CDbl(CDate(arr(i, 2))) <= b Then
                     kq(i, 1) = "Co nam trong du lieu"
                End If
            End If
        Next i
         .Range("E2:E" & lr).Value = kq
    End With
End Sub
 
Lần chỉnh sửa cuối:

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,982
Được thích
13,620
Điểm
1,560
Chạy code
Mã:
Sub XYZ()
  Dim aCheck(), aData(), tArr, Res(), dic As Object
  Dim sRow&, i&, j&, iKey$, tmp
 
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("data")
    aData = .Range("B2", .Range("D" & Rows.Count).End(xlUp)).Value2
  End With
  sRow = UBound(aData)
  For i = 1 To sRow
    iKey = aData(i, 1)
    If Not dic.exists(iKey) Then
      dic.Add iKey, Array(i)
    Else
      tArr = dic.Item(iKey)
      ReDim Preserve tArr(0 To UBound(tArr) + 1)
      tArr(UBound(tArr)) = i
      dic.Item(iKey) = tArr
    End If
  Next i
 
  With Sheets("Check")
    aCheck = .Range("C2", .Range("D" & Rows.Count).End(xlUp)).Value2
    sRow = UBound(aCheck)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      iKey = aCheck(i, 1)
      If dic.exists(iKey) Then
        tmp = aCheck(i, 2)
        tmp = CDbl(CDate(Mid(tmp, 7, 4) & Mid(tmp, 3, 4) & Mid(tmp, 1, 2) & Mid(tmp, 11, 9)))
        tArr = dic.Item(iKey)
        For j = 0 To UBound(tArr)
          If tmp >= aData(tArr(j), 2) Then
            If tmp <= aData(tArr(j), 3) Then
              Res(i, 1) = "Co nam trong du lieu"
              Exit For
            End If
          End If
        Next j
      End If
    Next i
    .Range("E2").Resize(sRow).Value = Res
  End With
End Sub
 

tangoctuan

Thành viên chính thức
Tham gia ngày
22 Tháng tư 2008
Bài viết
93
Được thích
10
Điểm
670
Tuổi
35
Bạn thử code này nhé.Bạn chỉnh lại dữ liệu cho chuẩn ngày tháng năm 2 sheets nhé.
Mã:
Sub kiemtra()
    Dim i As Long, lr As Long, arr, data, kq, dic As Object, a As Double, b As Double, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        data = .Range("B2:D" & lr).Value
        For i = 1 To UBound(data)
            dk = data(i, 1)
            If Not dic.exists(dk) Then
               dic.Add dk, Array(CDbl(data(i, 2)), CDbl(data(i, 3)))
            Else
               a = dic.Item(dk)(0)
               b = dic.Item(dk)(1)
               If a > CDbl(data(i, 2)) Then a = CDbl(data(i, 2))
               If b < CDbl(data(i, 3)) Then b = CDbl(data(i, 3))
               dic.Item(dk) = Array(a, b)
           End If
       Next i
    End With
    With Sheets("Check")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         arr = .Range("C2:D" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 1)
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             If dic.exists(dk) Then
                a = dic.Item(dk)(0)
                b = dic.Item(dk)(1)
                If CDbl(CDate(arr(i, 2))) >= a And CDbl(CDate(arr(i, 2))) <= b Then
                     kq(i, 1) = "Co nam trong du lieu"
                End If
            End If
        Next i
         .Range("E2:E" & lr).Value = kq
    End With
End Sub
Chạy code
Mã:
Sub XYZ()
  Dim aCheck(), aData(), tArr, Res(), dic As Object
  Dim sRow&, i&, j&, iKey$, tmp

  Set dic = CreateObject("scripting.dictionary")
  With Sheets("data")
    aData = .Range("B2", .Range("D" & Rows.Count).End(xlUp)).Value2
  End With
  sRow = UBound(aData)
  For i = 1 To sRow
    iKey = aData(i, 1)
    If Not dic.exists(iKey) Then
      dic.Add iKey, Array(i)
    Else
      tArr = dic.Item(iKey)
      ReDim Preserve tArr(0 To UBound(tArr) + 1)
      tArr(UBound(tArr)) = i
      dic.Item(iKey) = tArr
    End If
  Next i

  With Sheets("Check")
    aCheck = .Range("C2", .Range("D" & Rows.Count).End(xlUp)).Value2
    sRow = UBound(aCheck)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      iKey = aCheck(i, 1)
      If dic.exists(iKey) Then
        tmp = aCheck(i, 2)
        tmp = CDbl(CDate(Mid(tmp, 7, 4) & Mid(tmp, 3, 4) & Mid(tmp, 1, 2) & Mid(tmp, 11, 9)))
        tArr = dic.Item(iKey)
        For j = 0 To UBound(tArr)
          If tmp >= aData(tArr(j), 2) Then
            If tmp <= aData(tArr(j), 3) Then
              Res(i, 1) = "Co nam trong du lieu"
              Exit For
            End If
          End If
        Next j
      End If
    Next i
    .Range("E2").Resize(sRow).Value = Res
  End With
End Sub
Cảm ơn các bác rất nhiều, 2 code đều chạy rất chính xác. Một lần nữa cám ơn 2 bác!
 
Top Bottom