Tự nhảy qua ngày mới khi đến mốc 24 giờ

[Thư Sinh Áo Trắng]

- Chia thời gian trong ngày thành 46 mốc, tức 30 phút = 1 mốc thời gian. Vậy 1 ngày có 46 mốc. Làm sao để nhảy qua ngày mới khi qua thời điểm 23h30 ngày hôm đó.
- Xin giúp đỡ công thức (hàm excel) hoặc Sub/Function (chương trình VBA) để lịch tự nhảy qua ngày mới khi kéo ô ngày vượt qua mộc 23h30
(file đính kèm)

 

[HieuCD]

Oánh Pôn Pốt ạ.
Còn của em nó muốn theo thứ tự từ trên xuống dưới ở cột D ạ. Bác bớt em 1/(24*60) sửa em tý.

Code chỉ lấy 8 ngày

4/30/1975​

5/3/1975​

6/9/1975​

7/3/1975​

8/4/1975​

9/15/1975​

10/18/1975​

12/11/1975​

 

[Thư Sinh Áo Trắng]

Code chỉ lấy 8 ngày

4/30/1975​

5/3/1975​

6/9/1975​

7/3/1975​

8/4/1975​

9/15/1975​

10/18/1975​

12/11/1975​

Còn nhiều nữa ạ. Nó chỉ có quy luật tăng dần nhưng không liên tục. Em để nó vào vòng lặp vì nhiều quá không tính lrow bằng tay đc.

 

[HieuCD]

Còn nhiều nữa ạ. Nó chỉ có quy luật tăng dần nhưng không liên tục. Em để nó vào vòng lặp vì nhiều quá không tính lrow bằng tay đc.

Ý bạn như vầy

Từ ngày	Đến ngày
4/30/1975	5/3/1975
6/9/1975	7/3/1975
8/4/1975	9/15/1975
10/18/1975	12/11/1975

 

[Thư Sinh Áo Trắng]

Ý bạn như vầy

Từ ngày	Đến ngày
4/30/1975	5/3/1975
6/9/1975	7/3/1975
8/4/1975	9/15/1975
10/18/1975	12/11/1975

Chia 1 ngày thành 48 mốc 30 phút. Và đến mốc 00:00 thì nhảy sang ngày khác.
Theo thứ tự từ trên xuống dưới như cột này anh ạ. Em có làm cái If-End khi 00:00 lựa lần lượt từ trên xuống dưới nhưng chạy chưa dc.

 

[HieuCD]

View attachment 258230
Chia 1 ngày thành 48 mốc 30 phút. Và đến mốc 00:00 thì nhảy sang ngày khác.
Theo thứ tự từ trên xuống dưới như cột này anh ạ. Em có làm cái If-End khi 00:00 lựa lần lượt từ trên xuống dưới nhưng chạy chưa dc.

Chạy code

Sub ABC()
  Dim aDate(), Res(), sRow&, srRes&, i&, j&, k&
  Dim N&, dTime#, iTime#, iDate As Date
 
  dTime = 1 / 24 / (60 / 30) 'buoc nhay 30 phut
  N = Application.RoundUp(1 / dTime, 0) 'so buoc nhay 30 phut trong 1 ngay
  aDate = Range("D2", Range("D" & Rows.Count).End(xlUp)).Value
  sRow = UBound(aDate)
  srRes = sRow * N
  If srRes > 1000000 Then Exit Sub
  ReDim Res(1 To srRes, 1 To 2)
  For i = 1 To sRow
    iDate = aDate(i, 1)
    iTime = 0
    For j = 1 To N
      k = k + 1
      Res(k, 1) = iDate
      Res(k, 2) = iTime
      iTime = iTime + dTime
    Next j
  Next i
  Range("A2", Range("B" & Rows.Count).End(xlUp)).ClearContents
  Range("A2").Resize(srRes, 1).NumberFormat = "dd/mm/yyyy"
  Range("B2").Resize(srRes, 1).NumberFormat = "hh:mm"
  Range("A2").Resize(srRes, 2) = Res
End Sub

 

[Thư Sinh Áo Trắng]

Chạy code

Sub ABC()
  Dim aDate(), Res(), sRow&, srRes&, i&, j&, k&
  Dim N&, dTime#, iTime#, iDate As Date

  dTime = 1 / 24 / (60 / 30) 'buoc nhay 30 phut
  N = Application.RoundUp(1 / dTime, 0) 'so buoc nhay 30 phut trong 1 ngay
  aDate = Range("D2", Range("D" & Rows.Count).End(xlUp)).Value
  sRow = UBound(aDate)
  srRes = sRow * N
  If srRes > 1000000 Then Exit Sub
  ReDim Res(1 To srRes, 1 To 2)
  For i = 1 To sRow
    iDate = aDate(i, 1)
    iTime = 0
    For j = 1 To N
      k = k + 1
      Res(k, 1) = iDate
      Res(k, 2) = iTime
      iTime = iTime + dTime
    Next j
  Next i
  Range("A2", Range("B" & Rows.Count).End(xlUp)).ClearContents
  Range("A2").Resize(srRes, 1).NumberFormat = "dd/mm/yyyy"
  Range("B2").Resize(srRes, 1).NumberFormat = "hh:mm"
  Range("A2").Resize(srRes, 2) = Res
End Sub

Em xin. Cảm ơn anh @HieuCD !
Cảm ơn các bác @VetMini @phuocam @Maika8008 đã cho code trong Top này.