VBA nu funcționează

Am copiat VBA pentru copierea datelor din celulă în același rând coloană diferită și l-am schimbat astfel încât să pot schimba o celulă din coloana F și să salvez valoarea în coloana E, dar când încerc nu se întâmplă nimic. Poate cineva sa-mi spuna ce gresesc? De asemenea, aș dori să plasez un marcaj de dată în coloana G când fac modificarea.

Speram să pot face același lucru atunci când schimb o celulă din coloana I pentru a o salva în coloana H și marcarea datei acea modificare în coloana J.

Orice ajutor ar fi foarte apreciat.


Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dim I As Long
Dim xCell As Range
Dim xDCell As Range
Dim xHeader ca șir
Dim xCommText ca șir
La data de eroare CV următoare
Application.ScreenUpdating = Fals
Application.EnableEvents = Fals
xHeader = "Valoare anterioară:"
x = xDic.Taste
Pentru I = 0 La UBound(xDic.Keys)
Setați xCell = Range(xDic.Keys(I))
Setați xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Pagina Următoare →
Application.EnableEvents = Adevărat
Application.ScreenUpdating = Adevărat
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim I, J As Long
Dim xRgArea As Range
La eroare GoTo Label1
Dacă Target.Count > 1, apoi Ieșiți din sub
Application.EnableEvents = Fals
Set xDependRg = Target.Dependents
Dacă xDependRg este Nimic, atunci GoTo Label1
Dacă nu, xDependRg este nimic, atunci
Set xDependRg = Intersect(xDependRg, Range("F:F"))
Final, dacă
Eticheta 1:
Set xRg = Intersect(Target, Range("F:F"))
Dacă (Nu xRg este nimic) și (Nu xDependRg este nimic) atunci
Setați xChangeRg = Uniune(xRg, xDependRg)
ElseIf (xRg este nimic) și (nu xDependRg este nimic) atunci
Setați xChangeRg = xDependRg
ElseIf (Nu xRg este nimic) și (xDependRg este nimic) atunci
Setați xChangeRg = xRg
Altfel
Application.EnableEvents = Adevărat
Ieșiți din Sub
Final, dacă
xDic.RemoveAll
Pentru I = 1 To xChangeRg.Areas.Count
Set xRgArea = xChangeRg.Areas(I)
Pentru J = 1 To xRgArea.Count
xDic.Adăugați xRgArea(J).Adresă, xRgArea(J).Formulă
Pagina Următoare →
Pagina Următoare →
Set xChangeRg = Nimic
Set xRg = Nimic
Set xDependRg = Nimic
Application.EnableEvents = Adevărat
End Sub