Tôi đã sao chép VBA để sao chép dữ liệu từ ô vào cùng một hàng trong một cột khác và thay đổi nó để tôi có thể thay đổi một ô trong Cột F và lưu giá trị vào cột E, nhưng khi tôi thử thì không có gì xảy ra. Ai đó có thể cho tôi biết những gì tôi đang làm sai? Tôi cũng muốn đặt dấu thời gian vào cột G khi thực hiện thay đổi.
Tôi đã hy vọng cũng có thể làm điều tương tự khi tôi thay đổi một ô trong Cột I để lưu nó vào Cột H và dấu thời gian thay đổi trong Cột J.
Bất kỳ trợ giúp sẽ được đánh giá cao.
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
Ứng dụng.EnableEvents = True
Application.ScreenUpdating = Đúng
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
Tôi đã hy vọng cũng có thể làm điều tương tự khi tôi thay đổi một ô trong Cột I để lưu nó vào Cột H và dấu thời gian thay đổi trong Cột J.
Bất kỳ trợ giúp sẽ được đánh giá cao.
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
Ứng dụng.EnableEvents = True
Application.ScreenUpdating = Đúng
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