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ỉ.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:
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.
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.
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ì.
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.
À trong file mình gửi cũng có cả mẫu rồi bạn.
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à.À 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é.
Đây bạn ơi.
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é.
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 SubChạy code
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 SubCả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!
