J'ai copié le VBA pour copier les données d'une cellule dans une colonne différente de la même ligne et l'ai modifié pour pouvoir modifier une cellule dans la colonne F et enregistrer la valeur dans la colonne E, mais lorsque je l'essaie, rien ne se passe. Quelqu'un peut-il me dire ce que je fais mal? Je voudrais également placer un horodatage dans la colonne G lorsque j'effectue le changement.
J'espérais également pouvoir faire la même chose lorsque je change une cellule dans la colonne I pour l'enregistrer dans la colonne H et l'horodatage qui change dans la colonne J.
Toute aide serait grandement appréciée.
Dim xRg comme plage
Dim xChangeRg comme plage
Dim xDependRg comme plage
Dim xDic comme nouveau dictionnaire
Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Dim I aussi longtemps
Dim xCell comme plage
Dim xDCell comme plage
Estomper xHeader en tant que chaîne
Dim xCommText en tant que chaîne
On Error Resume Next
Application.ScreenUpdating = Faux
Application.EnableEvents = False
xHeader = "Valeur précédente :"
x = xDic.Keys
Pour I = 0 Vers UBound(xDic.Keys)
Définir xCell = Range(xDic.Keys(I))
Définir xDCell = Cells(xCell.Row, 5)
xDCell.Valeur = ""
xDCell.Value = xDic.Items(I)
Suivant
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange (Cible ByVal en tant que plage)
Dim I, J aussi longtemps
Dim xRgArea comme plage
En cas d'erreur GoTo Label1
Si Target.Count> 1, puis quitter le sous-marin
Application.EnableEvents = False
Définir xDependRg = Target.Dependents
Si xDependRg n'est rien, alors GoTo Label1
Si non xDependRg n'est rien alors
Set xDependRg = Intersection(xDependRg, Range("F:F"))
Si fin
Libellé1 :
Définir xRg = Intersection(Cible, Plage("F:F"))
Si (non xRg n'est rien) et (non xDependRg n'est rien) alors
Définir xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Alors
Définir xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Alors
Définir xChangeRg = xRg
autre
Application.EnableEvents = True
Exit Sub
Si fin
xDic.RemoveAll
Pour I = 1 Vers xChangeRg.Areas.Count
Définir xRgArea = xChangeRg.Areas(I)
Pour J = 1 à xRgArea.Count
xDic.Ajouter xRgArea(J).Adresse, xRgArea(J).Formule
Suivant
Suivant
Définir xChangeRg = Rien
Définir xRg = Rien
Définir xDependRg = Rien
Application.EnableEvents = True
End Sub
J'espérais également pouvoir faire la même chose lorsque je change une cellule dans la colonne I pour l'enregistrer dans la colonne H et l'horodatage qui change dans la colonne J.
Toute aide serait grandement appréciée.
Dim xRg comme plage
Dim xChangeRg comme plage
Dim xDependRg comme plage
Dim xDic comme nouveau dictionnaire
Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Dim I aussi longtemps
Dim xCell comme plage
Dim xDCell comme plage
Estomper xHeader en tant que chaîne
Dim xCommText en tant que chaîne
On Error Resume Next
Application.ScreenUpdating = Faux
Application.EnableEvents = False
xHeader = "Valeur précédente :"
x = xDic.Keys
Pour I = 0 Vers UBound(xDic.Keys)
Définir xCell = Range(xDic.Keys(I))
Définir xDCell = Cells(xCell.Row, 5)
xDCell.Valeur = ""
xDCell.Value = xDic.Items(I)
Suivant
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange (Cible ByVal en tant que plage)
Dim I, J aussi longtemps
Dim xRgArea comme plage
En cas d'erreur GoTo Label1
Si Target.Count> 1, puis quitter le sous-marin
Application.EnableEvents = False
Définir xDependRg = Target.Dependents
Si xDependRg n'est rien, alors GoTo Label1
Si non xDependRg n'est rien alors
Set xDependRg = Intersection(xDependRg, Range("F:F"))
Si fin
Libellé1 :
Définir xRg = Intersection(Cible, Plage("F:F"))
Si (non xRg n'est rien) et (non xDependRg n'est rien) alors
Définir xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Alors
Définir xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Alors
Définir xChangeRg = xRg
autre
Application.EnableEvents = True
Exit Sub
Si fin
xDic.RemoveAll
Pour I = 1 Vers xChangeRg.Areas.Count
Définir xRgArea = xChangeRg.Areas(I)
Pour J = 1 à xRgArea.Count
xDic.Ajouter xRgArea(J).Adresse, xRgArea(J).Formule
Suivant
Suivant
Définir xChangeRg = Rien
Définir xRg = Rien
Définir xDependRg = Rien
Application.EnableEvents = True
End Sub