CẬP NHẬT
VBA đang hoạt động! Xin vui lòng xem mã dưới đây. Tôi chỉ cần trợ giúp sửa đổi nó để khi tôi thay đổi một ô trong Cột, nó sẽ lưu giá trị vào Cột H.
Dim xRg theo phạm vi
Dim xChangeRg dưới dạng phạm vi
Dim xDependRg dưới dạng phạm vi
Dim xDic Như Từ Điển Mới
Private Sub Worksheet_Change (ByVal Target As Range)
Dim I As Long
Dim xCell theo phạm vi
Dim xDcell dưới dạng phạm vi
Dim xHeader dưới dạng chuỗi
Dim xCommText dưới dạng Chuỗi
On Error Resume Next
Application.ScreenUpdating = Sai
Application.EnableEvents = Sai
xHeader = "Giá trị trước đó:"
x = xDic.Keys
Đối với I = 0 Đến UBound (xDic.Keys)
Đặt xCell = Range(xDic.Keys(I))
Đặt xDCell = Cells (xCell.Row, 5)
xDcell.Value = ""
xDcell.Value = xDic.Items(I)
Sau
Nếu Target.Column = 6 Thì
Application.EnableEvents = Sai
Ô(Target.Row, 7).Value = Ngày
Ứng dụng.EnableEvents = True
Cuối Nếu
Nếu Target.Column = 9 Thì
Application.EnableEvents = Sai
Ô(Target.Row, 10).Value = Ngày
Ứng dụng.EnableEvents = True
Cuối Nếu
Ứng dụng.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim I, J As Long
Dim xRgArea theo phạm vi
Khi gặp lỗi GoTo Label1
If Target.Count> 1 Then Exit Sub
Application.EnableEvents = Sai
Đặt xDependRg = Target.Dependents
Nếu xDependRg không có gì thì hãy chuyển đến Nhãn1
Nếu không phải xDependRg thì không có gì
Đặt xDependRg = Intersect(xDependRg, Range("F:F"))
Cuối Nếu
Nhãn1:
Đặt xRg = Intersect(Target, Range("F:F"))
Nếu (Không phải xRg là Không có gì) Và (Không phải xDependRg là Không có gì) Thì
Đặt xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Is nothing) And (Not xDependRg Is nothing) Then
Đặt xChangeRg = xDependRg
ElseIf (Không phải xRg là Không có gì) Và (xDependRg Không có gì) Thì
Đặt xChangeRg = xRg
Khác
Ứng dụng.EnableEvents = True
Thoát Sub
Cuối Nếu
xDic.RemoveTất cả
Đối với I = 1 Đến xChangeRg.Area.Count
Đặt xRgArea = xChangeRg.Area(I)
Đối với J = 1 Đến xRgArea.Count
xDic.Add xRgArea(J).Địa chỉ, xRgArea(J).Formula
Sau
Sau
Đặt xChangeRg = Không có gì
Đặt xRg = Không có gì
Đặt xDependRg = Không có gì
Ứng dụng.EnableEvents = True
End Sub