Kích hoạt Worksheet Change khi giá trị cell thay đổi theo hàm Excel (1 người xem)

[Vo Duy Minh]

Chào cac bạn
Rất mong nhận được sự hỗ trợ của các bạn với vấn đề sau.
Như trong file đính kèm, tôi dùng code dưới đây để ghi lại thời gian trong cột D (Sheet 1) khi giá trị dòng tương ứng ở cột C hiển thị (bất kỳ giá trị nào), và khi xóa giá trị ở cột C thì thời gian hiển thị trên cột D dòng tương ứng cũng tự delete.
Giá trị thời gian này sẽ không thay đổi.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("C2:C1000"), Range(Target.Address)) Is Nothing Then
If Range("C" & Target.Row).Value = "" Then
Range("D" & Target.Row).ClearContents
Else
Range("D" & Target.Row).Value = Time
End If
End If
End Sub

Vấn đề của tôi là giá trị (bất kỳ) ở cột C được thiết lập theo giá trị nhập vào ở một trang khác, trong file đính kèm là Sheet 2, cột A, dòng tương ứng.
Khi nhập giá trị vào cột A Sheet 2 thì giá trị ở cột C Sheet 1 dòng tương ứng sẽ hiển thị.
Tuy nhiên, khi giá trị ở cột C hiển thị thì thời gian không hiển thị trên cột D. Giá trị thời gian trên cột D chỉ có thể hiển thị (hoăc tự delete) khi cần phải nhấn Enter cho hàm Excel với giá trị trên cột C.

Rất mong nhận được sự hỗ trợ của các bạn để code VBA trện có thể kích hoạt ngay khi tôi nhập liệu vào cột A của Sheet 2.
Tôi cũng xin lỗi nếu như việc trình bày không được rõ ràng cho các bạn.

 

[Vo Duy Minh]

Rất cám ơn bạn "cantailieu" với cái code lâng cao của bạn.
Tôi thấy đưa vào ngay Sheet 1 code sau thì kết quả cũng tương tự.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("A:A"), Range(Target.Address)) Is Nothing Then
If Range("A" & Target.Row).Value = "" Then
Range("D" & Target.Row).ClearContents
Else
Range("D" & Target.Row).Value = Time
End If
End If
End Sub

Một lần nữa, rất cám ơn các bạn đã quan tâm.

 

[Vo Duy Minh]

Tôi có phần vội vã nên ... mừng hụt.
Sau khi thử hết các code, tôi thấy tất cả đều chạy tốt, nhưng tất cả cũng rơi vào đúng chỗ tôi "mắc nghẹn" mấy ngày nay.
Đó là giá trị Worksheet_Change ở cột D chỉ thay đổi do việc GÕ giá trị vào cột A (ở Sheet 1 hoặc Sheet 2), chứ không phải được kích hoạt do thay đổi (do hàm) ở cột C.
Vấn đề của tôi vì thế vẫn còn ở nguyên đó. Tôi muốn khi giá trị ở cột C xuất hiện (do việc gõ giá trị vào cột A hay bất kỳ chỗ nào khác trong Workbook) thì giá trị ở cột C sẽ kích hoạt Worksheet_Change để hiển thị thời gian vào cột D.

 

[Nhattanktnn]

Tôi có phần vội vã nên ... mừng hụt.
Sau khi thử hết các code, tôi thấy tất cả đều chạy tốt, nhưng tất cả cũng rơi vào đúng chỗ tôi "mắc nghẹn" mấy ngày nay.
Đó là giá trị Worksheet_Change ở cột D chỉ thay đổi do việc GÕ giá trị vào cột A (ở Sheet 1 hoặc Sheet 2), chứ không phải được kích hoạt do thay đổi (do hàm) ở cột C.
Vấn đề của tôi vì thế vẫn còn ở nguyên đó. Tôi muốn khi giá trị ở cột C xuất hiện (do việc gõ giá trị vào cột A hay bất kỳ chỗ nào khác trong Workbook) thì giá trị ở cột C sẽ kích hoạt Worksheet_Change để hiển thị thời gian vào cột D.

Nếu dữ liệu bạn không lớn thì:
1/ Sự kiện workbook open gán mảng dữ liệu chứa công thức vào một biến toàn cục
2/ Sự kiện Worksheet_Calculate trên worksheet, xét mảng công thức sau khi calculate có khác với giá trị mảng trong biến toàn cục đó không, nếu khác thì xử lý (thêm,xóa) thời gian
3/ Sau khi thêm/xóa thời gian thì gán lại vùng công thức vào biến mảng toàn cục đó

Vấn đề nhanh/chậm cứ chạy đúng đã rồi lo tốc độ. Mà với dữ liệu không quá lớn thì việc duyệt mảng vậy chắc cũng cỡ mili giây thôi

 

[cantl]

Nếu dữ liệu bạn không lớn thì:
1/ Sự kiện workbook open gán mảng dữ liệu chứa công thức vào một biến toàn cục
2/ Sự kiện Worksheet_Calculate trên worksheet, xét mảng công thức sau khi calculate có khác với giá trị mảng trong biến toàn cục đó không, nếu khác thì xử lý (thêm,xóa) thời gian
3/ Sau khi thêm/xóa thời gian thì gán lại vùng công thức vào biến mảng toàn cục đó

Vấn đề nhanh/chậm cứ chạy đúng đã rồi lo tốc độ. Mà với dữ liệu không quá lớn thì việc duyệt mảng vậy chắc cũng cỡ mili giây thôi

Há há há. Cái này chịu thôi.

Bài đã được tự động gộp: 30/11/22

Tôi có phần vội vã nên ... mừng hụt.
Sau khi thử hết các code, tôi thấy tất cả đều chạy tốt, nhưng tất cả cũng rơi vào đúng chỗ tôi "mắc nghẹn" mấy ngày nay.
Đó là giá trị Worksheet_Change ở cột D chỉ thay đổi do việc GÕ giá trị vào cột A (ở Sheet 1 hoặc Sheet 2), chứ không phải được kích hoạt do thay đổi (do hàm) ở cột C.
Vấn đề của tôi vì thế vẫn còn ở nguyên đó. Tôi muốn khi giá trị ở cột C xuất hiện (do việc gõ giá trị vào cột A hay bất kỳ chỗ nào khác trong Workbook) thì giá trị ở cột C sẽ kích hoạt Worksheet_Change để hiển thị thời gian vào cột D.

Trong lúc chờ đợi. Ở cột D, CTRL+SHIFT+; xem giờ tạm vậy.

 

[befaint]

Nếu dữ liệu bạn không lớn thì:
1/ Sự kiện workbook open gán mảng dữ liệu chứa công thức vào một biến toàn cục
2/ Sự kiện Worksheet_Calculate trên worksheet, xét mảng công thức sau khi calculate có khác với giá trị mảng trong biến toàn cục đó không, nếu khác thì xử lý (thêm,xóa) thời gian
3/ Sau khi thêm/xóa thời gian thì gán lại vùng công thức vào biến mảng toàn cục đó

Vấn đề nhanh/chậm cứ chạy đúng đã rồi lo tốc độ. Mà với dữ liệu không quá lớn thì việc duyệt mảng vậy chắc cũng cỡ mili giây thôi

Nội dung chính là như thế, nhưng nội dung phụ chiếm tới 99% bài giải.

Nguyên tắc đầu tiên: Đừng vội quan tâm đến cái người ta cần làm, mà quay về quá khứ, quay về cái gốc để giải quyết vấn đề = Code thay cái công thức là xong việc.

 

[Nhattanktnn]

Nội dung chính là như thế, nhưng nội dung phụ chiếm tới 99% bài giải.

Nguyên tắc đầu tiên: Đừng vội quan tâm đến cái người ta cần làm, mà quay về quá khứ, quay về cái gốc để giải quyết vấn đề = Code thay cái công thức là xong việc.

Bài này dài dòng ra là do một phần không có file sát thực tế, phần nữa là do không nhất quán trong câu hỏi. Lúc đầu thì dựa theo một vùng nhập liệu trên sheet2, mọi người code theo sự thay đổi của vùng trên sheet2 thì lại nói:

Tôi muốn khi giá trị ở cột C xuất hiện (do việc gõ giá trị vào cột A hay bất kỳ chỗ nào khác trong Workbook)

Thế nên cũng có thể là cái vùng công thức đó cũng có thể lấy từ một vùng công thức khác chứ chưa hẳn là vùng nhập dữ liệu, rồi cũng phải bắt sự kiện calculate mà thôi

 

[befaint]

Bài này dài dòng ra là do một phần không có file sát thực tế, phần nữa là do không nhất quán trong câu hỏi.

Mọi người sốt sắng quá, chứ xem file #1 chán đời quá... mặc kệ họ là xong.

 

[bebo021999]

Mình tạm thời chưa có thời gian. Bạn nào thử giùm:
Thử application.undo bên trong calculate event, để lấy giá trị cũ trong cột C, và so sánh với giá trị sau calculate trong cột C. Nếu khác thì cập nhật cột D.
Đừng quên tắt application.enableEvents trước khi Undo rồi mở lại.
Đại khái thế này:
Tại sheet1:

Private Sub Worksheet_Calculate()
Dim oldRng, newRng
newRng = Range("C8:C1000").Value
With Application
    .EnableEvents = False
     .Undo
     oldRng = Range("C8:C10").Value
    .EnableEvents = True
End With


'Sau đó duyệt 2 mảng old và new để tìm ra ô nào thay đổi và điền thời gian vô


End Sub

 

[HeSanbi]

@Vo Duy Minh​

Thử dùng Hàm bác nhé
Gõ vào ô D2
=ChangeTime(C3:C15)

'                    _,
' ___   _   _  _ ___(_)
'/ __| / \ | \| | _ | |
'\__ \/ \ \| \\ | _ \ |
'|___/_/ \_|_|\_|___/_|
'

Option Explicit

Private Type TypeArguments
  Action As Long
  Timer As Single
  Caller As Range
  Formula As String
  Target As Range
End Type

#If VBA7 Then
  Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
  Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
  Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If
Private Works() As TypeArguments

Function ChangeTime(Target As Range) As String
  On Error Resume Next
  Dim k As Integer, i%, r
  Set r = Application.Caller
  k = UBound(Works): k = k + 1
  ReDim Preserve Works(1 To k)
  With Works(k)
    .Action = 0
    .Formula = UCase(r.Formula)
    Set .Caller = r
    Set .Target = Target
  End With
  Call SetTimer(0&, 0&, 0, AddressOf ChangeTime_callback)
  ChangeTime = ""
End Function
#If VBA7 And Win64 Then
Private Sub ChangeTime_callback(ByVal hwnd As LongPtr, ByVal wMsg^, ByVal IdEvent As LongPtr, ByVal dwTime^)
#ElseIf VBA7 Then
Private Sub ChangeTime_callback(ByVal hwnd As LongPtr, ByVal wMsg&, ByVal IdEvent As LongPtr, ByVal dwTime&)
#Else
Private Sub ChangeTime_callback(ByVal hwnd&, ByVal wMsg&, ByVal IdEvent&, ByVal dwTime&)
#End If
  On Error Resume Next
  Call KillTimer(hwnd, IdEvent)
  Call KillTimer(0&, IdEvent)
  Call KillTimer(hwnd, 0&)
  Dim UA%, lr&, i%, j%, a1, a2
  Dim a As Object, B As TypeArguments, su As Boolean, ee As Boolean
 
  UA = UBound(Works)
  If UA = 0 Then Exit Sub
  For i = 1 To UA
    B = Works(i)
    Select Case B.Action
    Case 0
      Works(i).Action = 1
      If a Is Nothing Then
        Set a = Application
        ee = a.EnableEvents: If ee Then a.EnableEvents = False
        su = a.ScreenUpdating: If su Then a.ScreenUpdating = False
      End If
      lr = B.Target.Rows.Count
      If lr > 0 Then
        If lr = 1 Then
          ReDim a1(1, 1): ReDim a2(1, 1)
          a1(1, 1) = B.Target.Value
          a2(1, 1) = B.Caller(2, 1).Value
        Else
          a1 = B.Target.Resize(lr)
          a2 = B.Caller(2, 1).Resize(lr)
        End If
        For j = 1 To lr
          If a1(j, 1) = Empty Then
            a2(j, 1) = Empty
          Else
            If a2(j, 1) = Empty Then a2(j, 1) = Time
          End If
        Next
        B.Caller(2, 1).Resize(lr).Value = a2
      End If
    End Select
n:
  Next
  Erase Works
  If Not a Is Nothing Then
    If su And a.ScreenUpdating <> su Then a.ScreenUpdating = su
    If ee And a.EnableEvents <> ee Then a.EnableEvents = ee
    Set a = Nothing
  End If
End Sub

 

[Vo Duy Minh]

Tôi xin lỗi đã diễn đạt không rõ ràng khiến các bạn gặp nhiều phức tạp khi hỗ trợ tôi.
Mong các bạn bỏ qua giúp và cũng bỏ qua vấn đề này.
Dù sao đó cũng không hẳn là vấn đề quá lớn cho công việc của tôi, vả lại, nếu cần thì "tay chân" một chút bằng cách chịu khó nhấn Enter thôi.
Xin cám ơn sự quan tâm của tất cả các bạn trong hai ngày nay.
Mong rằng sau này tôi tiếp tục nhận được sự hỗ trợ của các bạn khi có vấn đề.

 

[cantl]

Tôi xin lỗi đã diễn đạt không rõ ràng khiến các bạn gặp nhiều phức tạp khi hỗ trợ tôi.
Mong các bạn bỏ qua giúp và cũng bỏ qua vấn đề này.
Dù sao đó cũng không hẳn là vấn đề quá lớn cho công việc của tôi, vả lại, nếu cần thì "tay chân" một chút bằng cách chịu khó nhấn Enter thôi.
Xin cám ơn sự quan tâm của tất cả các bạn trong hai ngày nay.
Mong rằng sau này tôi tiếp tục nhận được sự hỗ trợ của các bạn khi có vấn đề.

Thực ra cái này bác tìm hiểu tí cũng tự viết được thôi, chứ như em mới mò 1, 2 tháng mà đã ra được code lâng cao rồi đấy. Code em kết bỏ xừ luôn mà bác cầu toàn quá.
Kinh nghiệm của em là yêu cầu ngắn gọn, có hình ảnh mang tính chất minh họa cho sản phẩm là ngon ngay và nuôn.

 

[Vo Duy Minh]

Cám ơn bạn "cantailieu" nhiều lắm.
Với cái code này thì bạn nhọc nhằn quá.
Thật ra cái code trước của bạn cũng mở ra cho tôi hướng giải quyết khá tốt rồi.
Rất mong bạn không cần lo cho vấn đề này nhiều hơn khiến tôi rất áy náy.
Sau này mong rằng tôi tiếp tục nhận được sự giúp đỡ của bạn.
Chúc bạn nhiều sức khỏe.