Ik heb de VBA gekopieerd voor het kopiëren van gegevens van een cel naar dezelfde rij in een andere kolom en deze gewijzigd zodat ik een cel in kolom F kan wijzigen en de waarde in kolom E kan opslaan, maar als ik het probeer, gebeurt er niets. Kan iemand mij vertellen wat ik fout doe? Ik wil ook een datumstempel in kolom G plaatsen als ik de wijziging aanbreng.
Ik hoopte hetzelfde te kunnen doen wanneer ik een cel in kolom I wijzig om deze op te slaan in kolom H en die wijziging in kolom J van een datumstempel te voorzien.
Alle hulp zou zeer gewaardeerd worden.
Dim xRg als bereik
Dim xChangeRg als bereik
Dim xDependRg als bereik
Dim xDic als nieuw woordenboek
Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
Dim ik zo lang
Dim xCell als bereik
Dim xDCell als bereik
Dim xHeader als tekenreeks
Dim xCommText als tekenreeks
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Vorige waarde :"
x = xDic.Toetsen
Voor I = 0 Naar UBound(xDic.Keys)
Set xCell = Bereik(xDic.Keys(I))
Stel xDCell = Cellen in (xCell.Rij, 5)
xDCell.Waarde = ""
xDCell.Waarde = xDic.Items(I)
Volgende
Application.EnableEvents = Waar
Application.ScreenUpdating = True
End Sub
Privé subwerkblad_SelectionChange (ByVal-doel als bereik)
Dim I, J zo lang
Dim xRgArea als bereik
Bij fout Ga naar Label1
Als Target.Count > 1 Sub afsluiten
Application.EnableEvents = False
Stel xDependRg = Target.Dependents in
Als xDependRg niets is, ga dan naar Label1
Zo niet, dan is xDependRg niets
Set xDependRg = Intersect(xDependRg, Range("F:F"))
End If
Etiket1:
Set xRg = Intersect(Doel, Bereik("F:F"))
Als (Niet xRg Is Niets) En (Niet xDependRg Is Niets) Dan
Stel xChangeRg = Union(xRg, xDependRg) in
ElseIf (xRg is niets) en (niet xDependRg is niets) Dan
Stel xChangeRg = xDependRg in
ElseIf (Niet xRg Is Niets) En (xDependRg Is Niets) Dan
Stel xChangeRg = xRg in
Anders
Application.EnableEvents = Waar
Exit Sub
End If
xDic.Alles verwijderen
Voor I = 1 tot xChangeRg.Areas.Count
Stel xRgArea = xChangeRg.Areas(I) in
Voor J = 1 tot xRgArea.Count
xDic.Voeg xRgArea(J).Address, xRgArea(J).Formule toe
Volgende
Volgende
Stel xChangeRg = niets in
Stel xRg = Niets in
Stel xDependRg = niets in
Application.EnableEvents = Waar
End Sub
Ik hoopte hetzelfde te kunnen doen wanneer ik een cel in kolom I wijzig om deze op te slaan in kolom H en die wijziging in kolom J van een datumstempel te voorzien.
Alle hulp zou zeer gewaardeerd worden.
Dim xRg als bereik
Dim xChangeRg als bereik
Dim xDependRg als bereik
Dim xDic als nieuw woordenboek
Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
Dim ik zo lang
Dim xCell als bereik
Dim xDCell als bereik
Dim xHeader als tekenreeks
Dim xCommText als tekenreeks
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Vorige waarde :"
x = xDic.Toetsen
Voor I = 0 Naar UBound(xDic.Keys)
Set xCell = Bereik(xDic.Keys(I))
Stel xDCell = Cellen in (xCell.Rij, 5)
xDCell.Waarde = ""
xDCell.Waarde = xDic.Items(I)
Volgende
Application.EnableEvents = Waar
Application.ScreenUpdating = True
End Sub
Privé subwerkblad_SelectionChange (ByVal-doel als bereik)
Dim I, J zo lang
Dim xRgArea als bereik
Bij fout Ga naar Label1
Als Target.Count > 1 Sub afsluiten
Application.EnableEvents = False
Stel xDependRg = Target.Dependents in
Als xDependRg niets is, ga dan naar Label1
Zo niet, dan is xDependRg niets
Set xDependRg = Intersect(xDependRg, Range("F:F"))
End If
Etiket1:
Set xRg = Intersect(Doel, Bereik("F:F"))
Als (Niet xRg Is Niets) En (Niet xDependRg Is Niets) Dan
Stel xChangeRg = Union(xRg, xDependRg) in
ElseIf (xRg is niets) en (niet xDependRg is niets) Dan
Stel xChangeRg = xDependRg in
ElseIf (Niet xRg Is Niets) En (xDependRg Is Niets) Dan
Stel xChangeRg = xRg in
Anders
Application.EnableEvents = Waar
Exit Sub
End If
xDic.Alles verwijderen
Voor I = 1 tot xChangeRg.Areas.Count
Stel xRgArea = xChangeRg.Areas(I) in
Voor J = 1 tot xRgArea.Count
xDic.Voeg xRgArea(J).Address, xRgArea(J).Formule toe
Volgende
Volgende
Stel xChangeRg = niets in
Stel xRg = Niets in
Stel xDependRg = niets in
Application.EnableEvents = Waar
End Sub