UPPDATERING
VBA fungerar! Se koden nedan. Jag behöver bara hjälp med att ändra det så att när jag ändrar en cell i kolumn I sparas värdet i kolumn H.
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
Om Target.Column = 6 Då
Application.EnableEvents = False
Cells(Target.Row, 7).Value = Datum
Application.EnableEvents = True
End If
Om Target.Column = 9 Då
Application.EnableEvents = False
Cells(Target.Row, 10).Value = Datum
Application.EnableEvents = True
End If
Application.EnableEvents = 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