Sélectionner la cellule au dessus de la cellule modifiée

[chris6999]

Bonsoir

Pensez vous qu'il y aurait un moyen dans une macro d'identifier la cellule au dessus de la cellule qui a été modifiée.

Je m'explique lorsque je saisis une date dans la plage C7 à L7, mon Userform avec listbox apparaît et me présente une liste de valeur à sélectionner.
Je souhaiterais que la valeur sélectionnée se positionne dans la cellule au dessus de celle qui a déclenché le worksheet change.

Mais est-ce possible?

Je mets mon fichier test en PJ . Par contre l'incrémentation depuis la listbox est figée sur D7 pour l'exemple.

Merci d'avance
Cordialement

 

[phlaurent55]

Re : Sélectionner la cellule au dessus de la cellule modifiée

Bonjour Chris,

ton fichier en retour

à+
Philippe

 

[chris6999]

Re : Sélectionner la cellule au dessus de la cellule modifiée

Bonjour et merci Philippe c'est maqique!
Je vais essayer de bien comprendre le principe.

J'espère ne pas trop abuser mais j'ai une autre petite question.
J'aimerais que l'Userform ne s'affiche pas lorsque je supprime le contenu de la cellule dans la plage (C7 à L7).

Est-ce que c'est possible?

Cordialement

 

[Dull]

Re : Sélectionner la cellule au dessus de la cellule modifiée

Salut chris6999, Philippe🙂, le Forum

A tester

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target,[C7:L7]) Is Nothing Then [A1] = Target.Column: UserForm1.Show
End Sub

Bonne Journée

 

[chris6999]

Re : Sélectionner la cellule au dessus de la cellule modifiée

Bonjour et merci DULL

Ta proposition fonctionne mais par contre quand je supprime le contenu de la cellule l'Userform s'affiche toujours.

Cordialement

 

[Dull]

Re : Sélectionner la cellule au dessus de la cellule modifiée

Re le Fil

Alors peut -être cela

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Not Intersect(Target, [C7:L7]) Is Nothing Then [A1] = Target.Column: UserForm1.Show
End Sub

Bonne Journée

 

[chris6999]

Re : Sélectionner la cellule au dessus de la cellule modifiée

Bravo DULL cela fonctionne nickel/

Merci encore à tous les deux et bonne journée

 

[phlaurent55]

Re : Sélectionner la cellule au dessus de la cellule modifiée

Re bonjour à tous

une modif concernant l'effacement de la cellule de la ligne 6 lorsqu'on supprime une donnée de la ligne 7

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [C7:L7]) Is Nothing And Target = "" Then
Target.Offset(-1, 0) = ""
Exit Sub
End If
If Not Intersect(Target, [C7:L7]) Is Nothing Then [A1] = Target.Column: UserForm1.Show
End Sub

à+
Philippe

 

[Si...]

Re : Sélectionner la cellule au dessus de la cellule modifiée

salut

Si... tu veux te dispenser de l'userform :

Private Sub Worksheet_Change(ByVal R As Range)
  Dim T As Byte
  If Intersect(R, [C7:L7]) Is Nothing Or R.Count > 1 Then Exit Sub
  If IsDate(R) Then
    T = 1 + Int((Month(R) - 1) / 3)
    R(0, 1) = T & IIf(T = 1, "er", "ème")
  Else
    Application.EnableEvents = False
    R = "": R(0, 1) = ""
    Application.EnableEvents = True
  End If
End Sub

 

[chris6999]

Re : Sélectionner la cellule au dessus de la cellule modifiée

Merci Philippe

C'est la cerise sur le gateau

Bonne journée

 

[chris6999]

Re : Sélectionner la cellule au dessus de la cellule modifiée

Bonjour
Ta proposition me faciliterait grandement les choses sauf que....
Le trimestre qui remonte n'est pas forcément celui du mois.
Je m'explique :

Les dates du 1 au 6 janvier sont rattachées au 4ème trimestre de l'année précédente et non au 1er trim de l'année en cours.

Pou février et mars aucun problème qq soit le jour c'est bien le 1er trimestre qui doit remonter.

Les dates du 1 au 6 avril sont rattachées au 1er trimestre (et non au second) et ainsi desuite

Si tu as une idée du comment écrire un code pouvant intégrer ces contraintes...

Merci et cordialement

salut

Si... tu veux te dispenser de l'userform :

Private Sub Worksheet_Change(ByVal R As Range)
  Dim T As Byte
  If Intersect(R, [C7:L7]) Is Nothing Or R.Count > 1 Then Exit Sub
  If IsDate(R) Then
    T = 1 + Int((Month(R) - 1) / 3)
    R(0, 1) = T & IIf(T = 1, "er", "ème")
  Else
    Application.EnableEvents = False
    R = "": R(0, 1) = ""
    Application.EnableEvents = True
  End If
End Sub