Chủ nhật, 18 tháng 12 2022
  2 Trả lời
  4.8 nghìn lượt truy cập
0
Bình chọn
Undo
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
1 năm trước
·
#3309
0
Bình chọn
Undo
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
1 năm trước
·
#3310
0
Bình chọn
Undo
Chỉ cần làm rõ, điều này sẽ bổ sung cho những gì nó đã làm. Tôi muốn có thể theo dõi các thay đổi được thực hiện trong cả cột F VÀ cột I. Xin lỗi vì sự nhầm lẫn.
  • Trang :
  • 1
Không có câu trả lời cho bài viết này.