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 đó.
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 đó.
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
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
Ở đâ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.
Ở đâ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é ^_^
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.