Ich habe die VBA zum Kopieren von Daten aus einer Zelle in eine andere Spalte derselben Zeile kopiert und so geändert, dass ich eine Zelle in Spalte F ändern und den Wert in Spalte E speichern kann, aber wenn ich es versuche, passiert nichts. Kann mir jemand sagen was ich falsch mache? Ich möchte auch einen Datumsstempel in Spalte G platzieren, wenn ich die Änderung vornehme.
Ich hatte gehofft, dasselbe tun zu können, wenn ich eine Zelle in Spalte I ändere, um sie in Spalte H zu speichern und diese Änderung in Spalte J zu datieren.
Jede Hilfe wäre sehr apprecaited.
Dim xRg als Bereich
Dim xChangeRg als Bereich
Dim xDependRg als Bereich
Dim xDic als neues Wörterbuch
Private Sub Worksheet_Change (ByVal-Ziel als Bereich)
Dimme ich so lange
xCell als Bereich dimmen
Dimmen Sie xDCell als Bereich
Dim xHeader als Zeichenfolge
Dim xCommText als Zeichenfolge
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = Falsch
xHeader = "Vorheriger Wert :"
x = xDic.Keys
Für I = 0 bis UBound(xDic.Keys)
Setze xCell = Range(xDic.Keys(I))
Setze xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Weiter
Application.EnableEvents = Wahr
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange (ByVal-Ziel als Bereich)
Dim I, J so lang
Dim xRgArea als Bereich
Bei Fehler GoTo Label1
Wenn Target.Count > 1, dann Sub verlassen
Application.EnableEvents = Falsch
Legen Sie xDependRg = Target.Dependents fest
Wenn xDependRg nichts ist, dann gehe zu Label1
Wenn nicht, dann ist xDependRg nichts
Setze xDependRg = Intersect(xDependRg, Range("F:F"))
End If
Etikett1:
Setze xRg = Intersect(Target, Range("F:F"))
Wenn (nicht xRg ist nichts) und (nicht xDependRg ist nichts) dann
Setze xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg ist nichts) und (nicht xDependRg ist nichts) Then
Setzen Sie xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) und (xDependRg Is Nothing) Then
Setzen Sie xChangeRg = xRg
sonst
Application.EnableEvents = Wahr
Exit Sub
End If
xDic.RemoveAll
Für I = 1 bis xChangeRg.Areas.Count
Setze xRgArea = xChangeRg.Areas(I)
Für J = 1 bis xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J).Formula
Weiter
Weiter
Setze xChangeRg = nichts
Setzen Sie xRg = nichts
Setze xDependRg = nichts
Application.EnableEvents = Wahr
End Sub
Ich hatte gehofft, dasselbe tun zu können, wenn ich eine Zelle in Spalte I ändere, um sie in Spalte H zu speichern und diese Änderung in Spalte J zu datieren.
Jede Hilfe wäre sehr apprecaited.
Dim xRg als Bereich
Dim xChangeRg als Bereich
Dim xDependRg als Bereich
Dim xDic als neues Wörterbuch
Private Sub Worksheet_Change (ByVal-Ziel als Bereich)
Dimme ich so lange
xCell als Bereich dimmen
Dimmen Sie xDCell als Bereich
Dim xHeader als Zeichenfolge
Dim xCommText als Zeichenfolge
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = Falsch
xHeader = "Vorheriger Wert :"
x = xDic.Keys
Für I = 0 bis UBound(xDic.Keys)
Setze xCell = Range(xDic.Keys(I))
Setze xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Weiter
Application.EnableEvents = Wahr
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange (ByVal-Ziel als Bereich)
Dim I, J so lang
Dim xRgArea als Bereich
Bei Fehler GoTo Label1
Wenn Target.Count > 1, dann Sub verlassen
Application.EnableEvents = Falsch
Legen Sie xDependRg = Target.Dependents fest
Wenn xDependRg nichts ist, dann gehe zu Label1
Wenn nicht, dann ist xDependRg nichts
Setze xDependRg = Intersect(xDependRg, Range("F:F"))
End If
Etikett1:
Setze xRg = Intersect(Target, Range("F:F"))
Wenn (nicht xRg ist nichts) und (nicht xDependRg ist nichts) dann
Setze xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg ist nichts) und (nicht xDependRg ist nichts) Then
Setzen Sie xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) und (xDependRg Is Nothing) Then
Setzen Sie xChangeRg = xRg
sonst
Application.EnableEvents = Wahr
Exit Sub
End If
xDic.RemoveAll
Für I = 1 bis xChangeRg.Areas.Count
Setze xRgArea = xChangeRg.Areas(I)
Für J = 1 bis xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J).Formula
Weiter
Weiter
Setze xChangeRg = nichts
Setzen Sie xRg = nichts
Setze xDependRg = nichts
Application.EnableEvents = Wahr
End Sub