Я скопировал VBA для копирования данных из ячейки в другой столбец той же строки и изменил его, чтобы я мог изменить ячейку в столбце F и сохранить значение в столбце E, но когда я пытаюсь ничего не происходит. Может кто-нибудь сказать мне, что я делаю неправильно? Я также хотел бы поместить метку даты в столбец G, когда я вношу изменения.

Я надеялся, что смогу сделать то же самое, когда я изменяю ячейку в столбце I, чтобы сохранить ее в столбце H и поставить отметку даты для этого изменения в столбце J.

Любая помощь будет очень признательна.


Dim xRg как диапазон
Dim xChangeRg как диапазон
Dim xDependRg как диапазон
Dim xDic как новый словарь
Private Sub Worksheet_Change (ByVal Target As Range)
Дим я пока
Dim xCell как диапазон
Dim xDCell как диапазон
Dim xHeader как строка
Dim xCommText как строка
On Error Resume Next
Приложение.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Предыдущее значение:"
x = xDic.Ключи
Для I = 0 в UBound(xDic.Keys)
Установите xCell = Range (xDic.Keys (I))
Установите xDCell = Cells (xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Следующая
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Дим I, J как долго
Dim xRgArea как диапазон
При ошибке Перейти к метке1
Если Target.Count > 1, то выйдите из Sub
Application.EnableEvents = False
Установите xDependRg = Target.Dependents
Если xDependRg ничего не значит, тогда GoTo Label1
Если не xDependRg ничего, то
Установить xDependRg = Intersect(xDependRg, Range("F:F"))
End If
Метка1:
Установите xRg = Intersect (Цель, Диапазон ("F: F"))
Если (Not xRg ничего не значит) и (Not xDependRg ничего не значит), то
Установите xChangeRg = Union (xRg, xDependRg)
ElseIf (xRg ничего) и (Not xDependRg ничего) тогда
Установите xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) И (xDependRg Is Nothing) Then
Установите xChangeRg = xRg
Еще
Application.EnableEvents = True
Exit Sub
End If
xDic.RemoveAll
Для I = 1 To xChangeRg.Areas.Count
Установить xRgArea = xChangeRg.Areas(I)
Для J = 1 To xRgArea.Count
xDic.Добавить xRgArea(J).Адрес, xRgArea(J).Формула
Следующая
Следующая
Установите xChangeRg = Ничего
Установите xRg = Ничего
Установите xDependRg = Ничего
Application.EnableEvents = True
End Sub