Tạo schedule chạy code VBA

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

castanea

Thành viên chính thức
Tham gia
28/4/09
Bài viết
55
Được thích
1
Chào mọi người,
Mình có 1 code VBA tên là TEST1 và mình có 1 timesheet ở cột A bắt đầu từ ô A2, mình muốn vào đúng giờ giờ tại cột A sẽ chạy code TEST1 cho đến khi code TEST1 chạy xong và tại ô B2 sẽ có 1 đồng hồ countdown cho khung giờ kế tiếp. thì mình nên code và làm như thế nào?
Thanks all
 
Chào mọi người,
Mình có 1 code VBA tên là TEST1 và mình có 1 timesheet ở cột A bắt đầu từ ô A2, mình muốn vào đúng giờ giờ tại cột A sẽ chạy code TEST1 cho đến khi code TEST1 chạy xong và tại ô B2 sẽ có 1 đồng hồ countdown cho khung giờ kế tiếp. thì mình nên code và làm như thế nào?
Thanks all
Bạn thử code dưới, code này sẽ kiểm tra cột A để xác định thời gian hiện tại và so sánh nó với thời gian trong timesheet. Nếu thời gian hiện tại khớp với một mục trong timesheet, code sẽ chạy một macro có tên là TEST1. Sau khi TEST1 chạy xong, một đồng hồ đếm ngược sẽ được hiển thị ở ô B2 cho đến thời gian kế tiếp trong timesheet.
PHP:
Option Explicit
' Macro chính để kiểm tra thời gian và chạy TEST1
Sub CheckTimeAndRunTEST1()
    Dim currentTime As Date
    Dim scheduledTime As Date
    Dim nextTime    As Date
    Dim timeSheetRange As Range
    Dim cell        As Range
    Dim countdown   As Double
    ' Thiết lập thời gian hiện tại
    currentTime = Now
    ' Thiết lập phạm vi của timesheet
    Set timeSheetRange = ThisWorkbook.Sheets("Sheet1").Range("A2:A100")        ' Giả sử timesheet có 100 hàng
    ' Duyệt qua timesheet để tìm thời gian khớp
    For Each cell In timeSheetRange
        If cell.Value <> "" Then
            scheduledTime = cell.Value
            If currentTime >= scheduledTime And currentTime <= scheduledTime + TimeValue("00:01:00") Then        ' So sánh trong khoảng 1 phút
            ' Chạy macro TEST1
            Call TEST1
            ' Tìm thời gian kế tiếp trong timesheet
            If Not cell.Offset(1, 0).Value = "" Then
                nextTime = cell.Offset(1, 0).Value
                ' Tính thời gian đếm ngược
                countdown = DateDiff("s", currentTime, nextTime)
                ' Hiển thị đồng hồ đếm ngược
                ThisWorkbook.Sheets("Sheet1").Range("B2").Value = Format(countdown / 86400, "hh:mm:ss")
            End If
            Exit Sub
        End If
    End If
Next cell
End Sub
' Macro TEST1 mà bạn muốn chạy
Sub TEST1()
    ' Code của TEST1 ở đây
    MsgBox "TEST1 Is running..."
    ' Thêm code của bạn vào đây
End Sub
Trong đoạn code trên, bạn cần thay thế ' Code của TEST1 ở đây bằng nội dung thực tế của macro TEST1 mà bạn muốn chạy. Đồng thời, bạn cũng cần điều chỉnh phạm vi của timeSheetRange cho phù hợp với số lượng hàng thực tế trong timesheet của bạn.

Lưu ý rằng đoạn code này giả định rằng các mục trong timesheet được định dạng là thời gian và không có ngày. Nếu timesheet của bạn có cả ngày và giờ, bạn sẽ cần điều chỉnh code để xử lý đúng định dạng đó.
 
Upvote 0
Bạn thử code dưới, code này sẽ kiểm tra cột A để xác định thời gian hiện tại và so sánh nó với thời gian trong timesheet. Nếu thời gian hiện tại khớp với một mục trong timesheet, code sẽ chạy một macro có tên là TEST1. Sau khi TEST1 chạy xong, một đồng hồ đếm ngược sẽ được hiển thị ở ô B2 cho đến thời gian kế tiếp trong timesheet.
PHP:
Option Explicit
' Macro chính để kiểm tra thời gian và chạy TEST1
Sub CheckTimeAndRunTEST1()
    Dim currentTime As Date
    Dim scheduledTime As Date
    Dim nextTime    As Date
    Dim timeSheetRange As Range
    Dim cell        As Range
    Dim countdown   As Double
    ' Thiết lập thời gian hiện tại
    currentTime = Now
    ' Thiết lập phạm vi của timesheet
    Set timeSheetRange = ThisWorkbook.Sheets("Sheet1").Range("A2:A100")        ' Giả sử timesheet có 100 hàng
    ' Duyệt qua timesheet để tìm thời gian khớp
    For Each cell In timeSheetRange
        If cell.Value <> "" Then
            scheduledTime = cell.Value
            If currentTime >= scheduledTime And currentTime <= scheduledTime + TimeValue("00:01:00") Then        ' So sánh trong khoảng 1 phút
            ' Chạy macro TEST1
            Call TEST1
            ' Tìm thời gian kế tiếp trong timesheet
            If Not cell.Offset(1, 0).Value = "" Then
                nextTime = cell.Offset(1, 0).Value
                ' Tính thời gian đếm ngược
                countdown = DateDiff("s", currentTime, nextTime)
                ' Hiển thị đồng hồ đếm ngược
                ThisWorkbook.Sheets("Sheet1").Range("B2").Value = Format(countdown / 86400, "hh:mm:ss")
            End If
            Exit Sub
        End If
    End If
Next cell
End Sub
' Macro TEST1 mà bạn muốn chạy
Sub TEST1()
    ' Code của TEST1 ở đây
    MsgBox "TEST1 Is running..."
    ' Thêm code của bạn vào đây
End Sub
Trong đoạn code trên, bạn cần thay thế ' Code của TEST1 ở đây bằng nội dung thực tế của macro TEST1 mà bạn muốn chạy. Đồng thời, bạn cũng cần điều chỉnh phạm vi của timeSheetRange cho phù hợp với số lượng hàng thực tế trong timesheet của bạn.

Lưu ý rằng đoạn code này giả định rằng các mục trong timesheet được định dạng là thời gian và không có ngày. Nếu timesheet của bạn có cả ngày và giờ, bạn sẽ cần điều chỉnh code để xử lý đúng định dạng đó.
Cám ơn anh đã chia sẽ. mình cũng đã dùng code của anh nhưng ko chạy được ko biết mình có làm sai gì ko anh xem giúp mình với.
 

File đính kèm

  • Test 1.xlsm
    16.8 KB · Đọc: 5
Upvote 0
Cám ơn anh đã chia sẽ. mình cũng đã dùng code của anh nhưng ko chạy được ko biết mình có làm sai gì ko anh xem giúp mình với.
Bạn thử chỉnh lại code:
PHP:
Option Explicit
   
' Bien toan cuc de theo doi thoi gian chay tiep theo
Dim NextScheduledTime As Date
   
Sub ScheduleTask()
    Dim ws          As Worksheet
    Dim TimeRange   As Range
    Dim TimeCell    As Range
    Dim CurrentTime As Date
    Dim ScheduledTime As Date
       
    ' Thiet lap tham chieu den Sheet1 va cot thoi gian
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set TimeRange = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
       
    ' Lay thoi gian hien tai
    CurrentTime = Now
       
    ' Duyet qua cot thoi gian de tim thoi gian chay tiep theo
    For Each TimeCell In TimeRange
        ScheduledTime = TimeCell.Value
        If ScheduledTime > CurrentTime Then
            ' Len lich chay macro RunScheduledMacro tai thoi gian da dinh
            NextScheduledTime = ScheduledTime
            Application.OnTime EarliestTime:=NextScheduledTime, Procedure:="RunScheduledMacro", Schedule:=True
            Exit Sub
        End If
    Next TimeCell
End Sub
   
Sub RunScheduledMacro()
    ' Chay macro TEST1
    TEST1
       
    ' Len lich lai macro tiep theo sau khi chay xong
    ScheduleTask
End Sub
   
Sub TEST1()
    ' Code cua TEST1 o day
    MsgBox "TEST1 Is running..."
    ' Them code cua ban vao day
       
    ' Cap nhat dong ho dem nguoc
    UpdateCountdown
End Sub
   
Sub UpdateCountdown()
    Dim ws          As Worksheet
    Dim NextTimeCell As Range
    Dim CurrentTime As Date
    Dim NextTime    As Date
    Dim Countdown   As Double
       
    Set ws = ThisWorkbook.Sheets("Sheet1")
    CurrentTime = Now
       
    ' Tim cell tiep theo co thoi gian lon hon thoi gian hien tai
    Set NextTimeCell = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).Find(What:=CurrentTime, After:=ws.Range("A2"), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
       
    If Not NextTimeCell Is Nothing Then
        NextTime = NextTimeCell.Value
        ' Tinh thoi gian dem nguoc
        Countdown = DateDiff("s", CurrentTime, NextTime)
        ' Hien thi dong ho dem nguoc
        ws.Range("B2").Value = Format(Countdown / 86400, "hh:mm:ss")
    Else
        ws.Range("B2").Value = "No more scheduled times."
    End If
End Sub

Và thêm code sau ở ThisWorkbook:
PHP:
Private Sub Workbook_Open()
' Goi Sub ScheduleTask khi workbook duoc mo
    Call ScheduleTask
End Sub
 
Upvote 0
Bạn thử chỉnh lại code:
PHP:
Option Explicit
  
' Bien toan cuc de theo doi thoi gian chay tiep theo
Dim NextScheduledTime As Date
  
Sub ScheduleTask()
    Dim ws          As Worksheet
    Dim TimeRange   As Range
    Dim TimeCell    As Range
    Dim CurrentTime As Date
    Dim ScheduledTime As Date
      
    ' Thiet lap tham chieu den Sheet1 va cot thoi gian
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set TimeRange = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
      
    ' Lay thoi gian hien tai
    CurrentTime = Now
      
    ' Duyet qua cot thoi gian de tim thoi gian chay tiep theo
    For Each TimeCell In TimeRange
        ScheduledTime = TimeCell.Value
        If ScheduledTime > CurrentTime Then
            ' Len lich chay macro RunScheduledMacro tai thoi gian da dinh
            NextScheduledTime = ScheduledTime
            Application.OnTime EarliestTime:=NextScheduledTime, Procedure:="RunScheduledMacro", Schedule:=True
            Exit Sub
        End If
    Next TimeCell
End Sub
  
Sub RunScheduledMacro()
    ' Chay macro TEST1
    TEST1
      
    ' Len lich lai macro tiep theo sau khi chay xong
    ScheduleTask
End Sub
  
Sub TEST1()
    ' Code cua TEST1 o day
    MsgBox "TEST1 Is running..."
    ' Them code cua ban vao day
      
    ' Cap nhat dong ho dem nguoc
    UpdateCountdown
End Sub
  
Sub UpdateCountdown()
    Dim ws          As Worksheet
    Dim NextTimeCell As Range
    Dim CurrentTime As Date
    Dim NextTime    As Date
    Dim Countdown   As Double
      
    Set ws = ThisWorkbook.Sheets("Sheet1")
    CurrentTime = Now
      
    ' Tim cell tiep theo co thoi gian lon hon thoi gian hien tai
    Set NextTimeCell = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).Find(What:=CurrentTime, After:=ws.Range("A2"), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
      
    If Not NextTimeCell Is Nothing Then
        NextTime = NextTimeCell.Value
        ' Tinh thoi gian dem nguoc
        Countdown = DateDiff("s", CurrentTime, NextTime)
        ' Hien thi dong ho dem nguoc
        ws.Range("B2").Value = Format(Countdown / 86400, "hh:mm:ss")
    Else
        ws.Range("B2").Value = "No more scheduled times."
    End If
End Sub

Và thêm code sau ở ThisWorkbook:
PHP:
Private Sub Workbook_Open()
' Goi Sub ScheduleTask khi workbook duoc mo
    Call ScheduleTask
End Sub
đã chỉnh sửa theo như hướng dẫn của anh nhưng vẫn chạy ko dc. anh có thể cho mình file đã chèn code được ko, sợ mình làm sai gì đó ko chạy dc.
thanks anh
 
Upvote 0
Mọi người giúp mình với
Ở đây có vài người kỵ tiếng Tây và tiếng viết tắt cho nên họ tránh làm cái này.

Chú thích:
Tôi làm vầy là cố ý "giúp" bạn chứ không phải phê phán như nhiều người nghĩ.
Nghe đến "tiếng Tây" và "viết tắt" thì sẽ có nhiều người nhào vào. Vì họ thích chứng minh là tôi sai.
 
Upvote 0
Ở đây có vài người kỵ tiếng Tây và tiếng viết tắt cho nên họ tránh làm cái này.

Chú thích:
Tôi làm vầy là cố ý "giúp" bạn chứ không phải phê phán như nhiều người nghĩ.
Nghe đến "tiếng Tây" và "viết tắt" thì sẽ có nhiều người nhào vào. Vì họ thích chứng minh là tôi sai.
Cám ơn bạn đã góp ý. Mình thì nghĩ đơn giản là diễn đàn hỗ trợ giúp đỡ chia sẽ kiến thức và từ viết tắc và "tiếng tây" nó cũng ko phải là gì ghê gớm như teen code hay thuật ngữ tiếng anh quá ghê gớm. nếu có điều gì làm mọi người ko hài lòng hay không vui thì bỏ qua giúp mình nhé ^_^
 
Upvote 0
Cám ơn bạn đã góp ý. Mình thì nghĩ đơn giản là diễn đàn hỗ trợ giúp đỡ chia sẽ kiến thức và từ viết tắc và "tiếng tây" nó cũng ko phải là gì ghê gớm như teen code hay thuật ngữ tiếng anh quá ghê gớm. nếu có điều gì làm mọi người ko hài lòng hay không vui thì bỏ qua giúp mình nhé ^_^
Tôi bỏ qua không nhìn bài từ đầu rồi.
Nhưng thấy ở bài #6 bạn lại nhờ "mọi người giúp", cho nên tôi nhắc khéo mấy người không kỵ tiếng Tây và viết tắt (tắt = rút ngắn; khác với tắc = nghẽn hoặc ứng ra nếu hiểu theo Hán Việt)
Bây giờ bạn muốn 'bỏ qua giúp" thì ở đây tôi sẽ lên tiếng chính thức bỏ qua:

Tuyên bố:
Tôi xin chính thức xin lỗi mọi người, kể cả chính chủ thớt.
Xin vui lòng cho tôi rút lại lời "Chú Thích" ở bài #7 trên.
 
Upvote 0
Web KT
Back
Top Bottom