VBA не працює

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

Я сподівався, що зможу зробити те саме, коли зміню клітинку в стовпці I, щоб зберегти її в стовпці H, і позначу цю зміну в стовпці J.

Будь-яка допомога буде дуже вдячна.


Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg як діапазон
Dim xDic як новий словник
Приватний допоміжний робочий лист_Change(ByVal Target As Range)
Dim I As Long
Dim xCell As Range
Dim xDCell As Range
Розменшувати xHeader як рядок
Dim xCommText As String
On Error Resume Next
Application.ScreenUpdating = Невірний
Application.EnableEvents = False
xHeader = "Попереднє значення:"
x = xDic.Keys
Для 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
Приватний додатковий аркуш_SelectionChange(ByVal Target As Range)
Dim I, J As Long
Dim xRgArea As Range
У разі помилки GoTo Label1
Якщо Target.Count > 1, то вийдіть із Sub
Application.EnableEvents = False
Установіть xDependRg = Target.Dependents
Якщо xDependRg нічого не означає, то GoTo Label1
Якщо не xDependRg, це нічого
Встановити xDependRg = Intersect(xDependRg, Range("F:F"))
End If
Label1:
Встановити xRg = Intersect(Target, Range("F:F"))
Якщо (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Then
Встановити xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg — це нічого) і (Not xDependRg — це нічого) Тоді
Встановіть xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) And (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.Add xRgArea(J).Address, xRgArea(J).Formula
МАЙБУТНІ
МАЙБУТНІ
Встановити xChangeRg = нічого
Встановіть xRg = Нічого
Встановити xDependRg = нічого
Application.EnableEvents = True
End Sub