Tìm này không xuất hiện trong khoảng thời gian (1 người xem)

tuan16 · Thứ năm lúc 17:40

Em xin nhờ các anh chị trong diễn đàn viết giúp em đoạn code để tìm được ngày không xuất hiện trong khoảng thời gian ạ. Trong file của em có ngày bắt đầu để ở cột f và ngày kết thúc để ở cột h và ngày hoàn thành để ở cột i.. trong ví dụ từ ngày 01/01/2024 đến 16/01/2024 thì em muốn tìm ra ngày 10/01/2024 sẽ là ngày không xuất hiện trong khoảng thời gian trên ạ. Ví dụ ở dòng số 7 ngày bắt đầu là 01/01/2024 và kết thúc là 03/01/2024 thì ngày 02/01/2024 vẫn được tính vào là có xuất hiện nên sẽ không liệt kê ra nữa ạ, tương tự với dòng số 8 ngày bắt đầu là 05/01/2024 và kết thúc là 09/01/2024 thì các ngày 06/01/2024, 07/01/2024, 08/01/2024 được tính là đã xuất hiện ạ

HUONGHCKT · Thứ năm lúc 18:24

tuan16 đã viết:
Em xin nhờ các anh chị trong diễn đàn viết giúp em đoạn code để tìm được ngày không xuất hiện trong khoảng thời gian ạ. Trong file của em có ngày bắt đầu để ở cột f và ngày kết thúc để ở cột h và ngày hoàn thành để ở cột i.. trong ví dụ từu ngày 01/01/2024 đến 16/01/2024 có thì em muốn tìm ra ngày 10/01/2024 sẽ là ngày không xuất hiện trong khoảng thời gian trên ạ. ví dụ ở dòng số 7 ngày bắt đầu là 01/01/2024 và kết thúc là 03/01/2024 thì ngày 02/01/2024 vẫn được tính vào là có xuất hiện nên sẽ không liệt kê ra nữa ạ, tương tự với dòng số 8 ngày bắt đầu là 05/01/2024 và kết thúc là 09/01/2024 thì các ngày 06/01/2024, 07/01/2024, 08/01/2024 được tính là đã xuất hiện ạ

Viết sai chính tả nhiều quá. Hãy xem và sửa lại trước khi post bài và cần rút kinh nghiệm luôn và ngay.
Trong khi chờ đợi các code khác. thử tham khảo đoạn code sau:

Mã:

Option Explicit

Sub TimNgay()
Dim i&, Lr&, t&, Ngay As Date, D As Date, eDay As Date
Dim Arr(), Res, Tu As Date, Den As Date
Dim Dic As Object, Key
With Sheet1
Lr = .Range("F10000").End(xlUp).Row
Arr = .Range("F7:I" & Lr).Value2
Set Dic = CreateObject("Scripting.Dictionary")
Tu = .[F6]: Den = .[H6]
    For i = 1 To UBound(Arr)
        If Arr(i, 4) <> Empty Then
            eDay = Arr(i, 4)
        Else
            If Arr(i, 3) <> Empty Then
                eDay = Arr(i, 3)
            End If
        End If
    For Ngay = Arr(i, 1) To eDay
        If Not Dic.Exists(Ngay) Then t = t + 1: Dic.Add (Ngay), t
    Next Ngay
Next i
For D = Tu To Den
    If Not Dic.Exists(D) Then
        If Res = Empty Then Res = D Else Res = Res & ", " & D
    End If
Next D
.Range("L8") = Res
End With
Set Dic = Nothing
End Sub

tuan16 · Thứ năm lúc 18:25

HUONGHCKT đã viết:

Viết sai chính tả nhiều quá. Hãy xem và sửa lại trước khi post bài và cần rút kinh nghiệm luôn và ngay.
Trong khi chờ đợi các code khác. thử tham khảo đoạn code sau:

Mã:

Option Explicit

Sub TimNgay()
Dim i&, Lr&, t&, Ngay As Date, D As Date, eDay As Date
Dim Arr(), Res, Tu As Date, Den As Date
Dim Dic As Object, Key
With Sheet1
Lr = .Range("F10000").End(xlUp).Row
Arr = .Range("F7:I" & Lr).Value2
Set Dic = CreateObject("Scripting.Dictionary")
Tu = .[F6]: Den = .[H6]
    For i = 1 To UBound(Arr)
        If Arr(i, 4) <> Empty Then
            eDay = Arr(i, 4)
        Else
            If Arr(i, 3) <> Empty Then
                eDay = Arr(i, 3)
            End If
        End If
    For Ngay = Arr(i, 1) To eDay
        If Not Dic.Exists(Ngay) Then t = t + 1: Dic.Add (Ngay), t
    Next Ngay
Next i
For D = Tu To Den
    If Not Dic.Exists(D) Then
        If Res = Empty Then Res = D Else Res = Res & ", " & D
    End If
Next D
.Range("L8") = Res
End With
Set Dic = Nothing
End Sub

Dạ vâng... Em sửa ạ.. Cảm ơn anh chị

HieuCD · Thứ năm lúc 21:33

tuan16 đã viết:
Em xin nhờ các anh chị trong diễn đàn viết giúp em đoạn code để tìm được ngày không xuất hiện trong khoảng thời gian ạ. Trong file của em có ngày bắt đầu để ở cột f và ngày kết thúc để ở cột h và ngày hoàn thành để ở cột i.. trong ví dụ từ ngày 01/01/2024 đến 16/01/2024 thì em muốn tìm ra ngày 10/01/2024 sẽ là ngày không xuất hiện trong khoảng thời gian trên ạ. Ví dụ ở dòng số 7 ngày bắt đầu là 01/01/2024 và kết thúc là 03/01/2024 thì ngày 02/01/2024 vẫn được tính vào là có xuất hiện nên sẽ không liệt kê ra nữa ạ, tương tự với dòng số 8 ngày bắt đầu là 05/01/2024 và kết thúc là 09/01/2024 thì các ngày 06/01/2024, 07/01/2024, 08/01/2024 được tính là đã xuất hiện ạ

Dùng mảng xử lý .

Mã:

Sub abc()
  Dim arr(), Res(), sRow&, i&, k&
  Dim d As Date, fDay As Date, eDay As Date

  With Sheets("Sheet1")
    arr = .Range("F7:I" & .Range("F1000000").End(xlUp).Row).Value
    fDay = Range("F6").Value
    eDay = Range("H6").Value
  End With
  sRow = UBound(arr)
  ReDim Res(1 To eDay - fDay + 1, 1 To 1)
 
  For d = fDay To eDay
    For i = 1 To sRow
      If d >= arr(i, 1) And (d <= arr(i, 3) Or d <= arr(i, 4)) Then Exit For
    Next i
    If i > sRow Then
      k = k + 1
      Res(k, 1) = d
    End If
  Next d
  Sheets("Sheet1").Range("L7").Resize(UBound(Res)) = Res
End Sub

tuan16 · Thứ năm lúc 21:57

HieuCD đã viết:

Dùng mảng xử lý .

Mã:

Sub abc()
  Dim arr(), Res(), sRow&, i&, k&
  Dim d As Date, fDay As Date, eDay As Date

  With Sheets("Sheet1")
    arr = .Range("F7:I" & .Range("F1000000").End(xlUp).Row).Value
    fDay = Range("F6").Value
    eDay = Range("H6").Value
  End With
  sRow = UBound(arr)
  ReDim Res(1 To eDay - fDay + 1, 1 To 1)
 
  For d = fDay To eDay
    For i = 1 To sRow
      If d >= arr(i, 1) And (d <= arr(i, 3) Or d <= arr(i, 4)) Then Exit For
    Next i
    If i > sRow Then
      k = k + 1
      Res(k, 1) = d
    End If
  Next d
  Sheets("Sheet1").Range("L7").Resize(UBound(Res)) = Res
End Sub

Em cảm ơn anh ạ

tuan16 · Hôm qua, lúc 08:38

HieuCD đã viết:

Dùng mảng xử lý .

Mã:

Sub abc()
  Dim arr(), Res(), sRow&, i&, k&
  Dim d As Date, fDay As Date, eDay As Date

  With Sheets("Sheet1")
    arr = .Range("F7:I" & .Range("F1000000").End(xlUp).Row).Value
    fDay = Range("F6").Value
    eDay = Range("H6").Value
  End With
  sRow = UBound(arr)
  ReDim Res(1 To eDay - fDay + 1, 1 To 1)
 
  For d = fDay To eDay
    For i = 1 To sRow
      If d >= arr(i, 1) And (d <= arr(i, 3) Or d <= arr(i, 4)) Then Exit For
    Next i
    If i > sRow Then
      k = k + 1
      Res(k, 1) = d
    End If
  Next d
  Sheets("Sheet1").Range("L7").Resize(UBound(Res)) = Res
End Sub

Em xin nhờ anh chị xem thêm ạ. Em có tải đoạn code về dùng thì có 1 số ngày không xuất hiện nhưng khi chạy code không ra kết quả ạ... cụ thể khi em chèn thêm ngày vào thì kết quả chạy ra không đúng ạ

HieuCD · Hôm qua, lúc 09:44

tuan16 đã viết:
Em xin nhờ anh chị xem thêm ạ. Em có tải đoạn code về dùng thì có 1 số ngày không xuất hiện nhưng khi chạy code không ra kết quả ạ... cụ thể khi em chèn thêm ngày vào thì kết quả chạy ra không đúng ạ

Thêm điều kiện khác empty
Tháng 9 không lấy do dòng dữ liệu 584

Mã:

Sub timngaytrong()
  Dim arr(), Res(), sRow&, i&, k&
  Dim d As Date, fDay As Date, eDay As Date

  With Sheets("Sheet1")
    arr = .Range("F7:I" & .Range("F1000000").End(xlUp).Row).Value
    fDay = .Range("F6").Value
    eDay = .Range("H6").Value
  End With
  sRow = UBound(arr)
  ReDim Res(1 To eDay - fDay + 1, 1 To 1)
 
  For d = fDay To eDay
    For i = 1 To sRow
      If ((d >= arr(i, 1) And arr(i, 1) <> Empty)) And (d <= arr(i, 3) Or d <= arr(i, 4)) Then Exit For
    Next i
    If i > sRow Then
      k = k + 1
      Res(k, 1) = d
    End If
  Next d
  Sheets("Sheet1").Range("l7").Resize(UBound(Res)) = Res
End Sub

tuan16 · Hôm qua, lúc 10:06

HieuCD đã viết:

Thêm điều kiện khác empty
Tháng 9 không lấy do dòng dữ liệu 584

Mã:

Sub timngaytrong()
  Dim arr(), Res(), sRow&, i&, k&
  Dim d As Date, fDay As Date, eDay As Date

  With Sheets("Sheet1")
    arr = .Range("F7:I" & .Range("F1000000").End(xlUp).Row).Value
    fDay = .Range("F6").Value
    eDay = .Range("H6").Value
  End With
  sRow = UBound(arr)
  ReDim Res(1 To eDay - fDay + 1, 1 To 1)
 
  For d = fDay To eDay
    For i = 1 To sRow
      If ((d >= arr(i, 1) And arr(i, 1) <> Empty)) And (d <= arr(i, 3) Or d <= arr(i, 4)) Then Exit For
    Next i
    If i > sRow Then
      k = k + 1
      Res(k, 1) = d
    End If
  Next d
  Sheets("Sheet1").Range("l7").Resize(UBound(Res)) = Res
End Sub

Em cảm ơn anh nhiều ạ

Tìm này không xuất hiện trong khoảng thời gian (1 người xem)

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

tuan16

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

File đính kèm

HUONGHCKT

Zalo 0986997214

tuan16

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

HieuCD

Chuyên gia GPE

tuan16

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

tuan16

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

File đính kèm

HieuCD

Chuyên gia GPE

tuan16

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

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

Đếm ngược thời gian