VBA nem működik

Másoltam a VBA-t az adatok másolásához a cellából egy sor másik oszlopába, és úgy változtattam, hogy módosíthassam az F oszlop celláját, és elmenthessem az értéket az E oszlopba, de amikor megpróbálom, nem történik semmi. Valaki meg tudná nekem mondani, hogy mit csinálok rosszul? A módosításkor dátumbélyeget is szeretnék elhelyezni a G oszlopban.

Azt reméltem, hogy ugyanezt meg tudom tenni, amikor megváltoztatok egy cellát az I. oszlopban, hogy elmentsem a H oszlopba, és dátumbélyegzővel látjam el a változást a J oszlopban.

Bármilyen segítséget nagyra értékelnénk.


Dim xrg mint tartomány
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic Új szótárként
Private Sub Worksheet_Change (ByVal Target mint Range)
Dim I As Long
Dim xCell As Range
Dim xDCell As Range
Dim xHeader As String
Dim xCommText As String
On Error Resume Next
Application.ScreenUpdating = Hamis
Application.EnableEvents = Hamis
xHeader = "Előző érték:"
x = xDic.Keys
Ha I = 0 - UBound(xDic.Keys)
xCell beállítása = Tartomány(xDic.Keys(I))
xDCell beállítása = Cellák (xCell.Sor, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Következő
Application.EnableEvents = Igaz
Application.ScreenUpdating = Igaz
End Sub
Private Sub Worksheet_SelectionChange (ByVal Target as Range)
Dim I, J As Long
Dim xRgArea As Range
Hiba esetén GoTo Label1
Ha Target.Count > 1, akkor lépjen ki a Sub
Application.EnableEvents = Hamis
Állítsa be: xDependRg = Target.Dependents
Ha az xDependRg semmi, akkor lépjen a Label1-re
Ha nem, az xDependRg Semmi akkor
Állítsa be az xDependRg = Metszéspont(xDependRg, Range("F:F"))
Ha véget
Címke1:
xRg beállítása = Metszéspont(Cél, Tartomány("F:F"))
Ha (Nem xRg semmi) És (Nem xDependRg semmi) Akkor
Állítsa be az xChangeRg = Unió(xRg, xDependRg)
ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Akkor
Állítsa be az xChangeRg = xDependRg értéket
ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Akkor
Állítsa be az xChangeRg = xRg beállítást
Más
Application.EnableEvents = Igaz
Exit Sub
Ha véget
xDic.RemoveAll
Ha I = 1 To xChangeRg.Areas.Count
Állítsa be az xRgArea = xChangeRg.Areas(I)
Ha J = 1 - xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J).Formula
Következő
Következő
Set xChangeRg = Semmi
Set xRg = Semmi
Állítsa be az xDependRg = Semmit
Application.EnableEvents = Igaz
End Sub