Jag har kopierat VBA för att kopiera data från cell till samma rad i en annan kolumn och ändrat den så att jag kan ändra en cell i kolumn F och spara värdet i kolumn E, men när jag försöker det händer ingenting. Kan någon berätta för mig vad jag gör för fel? Jag skulle också vilja placera en datumstämpel i kolumn G när jag gör ändringen.

Jag hoppades att jag också skulle kunna göra samma sak när jag ändrar en cell i kolumn I för att spara den i kolumn H och datumstämpla ändringen i kolumn J.

All hjälp skulle uppskattas mycket.


Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic som ny ordbok
Privata delarkivsförändring (ByVal-mål som område)
Dim I As Long
Dim xCell As Range
Dim xDCell As Range
Dim xHeader som sträng
Dim xCommText As String
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Föregående värde :"
x = xDic.Keys
För I = 0 Till UBound(xDic.Keys)
Ställ in xCell = Range(xDic.Keys(I))
Ställ in xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Nästa
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim I, J As Long
Dim xRgArea As Range
Vid fel GoTo Label1
Om Target.Count > 1 Avsluta Sub
Application.EnableEvents = False
Ställ in xDependRg = Target.Dependents
Om xDependRg är ingenting, gå till etikett1
Om inte xDependRg är ingenting då
Ange xDependRg = Intersect(xDependRg, Range("F:F"))
End If
Etikett 1:
Set xRg = Intersect(Target, Range("F:F"))
Om (Not xRg Is Nothing) Och (Not xDependRg Is Nothing) Då
Ställ in xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Is Nothing) Och (Not xDependRg Is Nothing) Then
Ställ in xChangeRg = xDependRg
ElseIf (Inte xRg Är Ingenting) Och (xDependRg Är Ingenting) Då
Ställ in xChangeRg = xRg
annars
Application.EnableEvents = True
Exit Sub
End If
xDic.RemoveAll
För I = 1 Till xChangeRg.Areas.Count
Ställ in xRgArea = xChangeRg.Areas(I)
För J = 1 Till xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J).Formel
Nästa
Nästa
Ställ in xChangeRg = Ingenting
Ställ in xRg = Ingenting
Ställ in xDependRg = Ingenting
Application.EnableEvents = True
End Sub