Recherche dans plage en excluant la cellule sélectionnée

Question

Je débute... Je cherche à incrémenter de 1 la valeur de la cellule se trouvant dans la plage (A8:A54) ayant la valeur de la cellule sélectionnée (il ne peut y en avoir qu'une). La cellule sélectionnée se trouvant également dans la plage (A8:A54), il faudrait je suppose l'exclure de la recherche.... Un gros merci...

ThauThème · Accepted Answer

Essaie comme ça : Sub Macro1() Dim CA As Range 'déclare la variable CA (Cellule Active) Dim PL As Range 'déclare la variable PL (PLage) Dim CEL As Range 'déclare la variable CEL (CELlule) Set CA = ActiveCell 'définit la cellule CA Set PL = Range("A8:A54") 'définit la plage PL For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL 'si la valeur de la cellule CEL est égale à la valeur de CA et les adresses sont différentes, incrémente CEL et sort de la procédure If CEL.Value = CA.Value And CEL.Address &lt;&gt; CA.Address Then CEL.Value = CEL.Value + 1: Exit Sub Next CEL 'prochaine cellule de la boucle End Sub...

ThauThème · Answer

Re,

Belle galère ! Mais je crois que c'est fonctionnel.

Commence par ajouter tout en haut du module [Tri_plage] la ligne :

Public AV As Byte 'déclare la variable AV (ancienne Valeur)

Puis les deux événementielles ci-dessous dans le composant Feuil2(Affectations possibles).

Pour-être sûr que ça fonctionne, il faut qu'au moins la première fois tu cliques d'abord dans la cellule A1 (pour définir l'ancienne valeur AV)... Après tout se fait automatiquement...

Private TEST As Boolean 'déclare la variable TEST

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'au changement de selection dans l'onglet
Dim PL As Range 'déclare la variable PL

Set PL = Range("A2:A41") 'définit la plage PL
If Intersect(PL, Target) Is Nothing Then Exit Sub 'si le changement a lieu ailleurs que dans la plage PL, sort de la procédure
If Target.Count > 1 Then Exit Sub 'si le changement a lieu dans plusieurs cellules de la plage PL, sort de la procédure
If TEST = True Then Exit Sub 'si TEST est [Vrai], sort de la procédure (je préfère ça à EnableEvents = False)
AV = Target.Value 'définit l'ancienne Valeur AV (déclarée publique dans le module [Tri_plage]
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim PL As Range 'déclare la variable PL
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim LD As Byte 'declare la variable LD (Ligne de Départ)
Dim LF As Byte 'declare la variable LF (Ligne de Fin)
Dim LI As Byte 'declare la variable LI (LIgne)

Set PL = Range("A2:A41") 'définit la plage PL
If Intersect(PL, Target) Is Nothing Then Exit Sub 'si le changement a lieu ailleurs que dans la plage PL, sort de la procédure
If Target.Count > 1 Then Exit Sub 'si le changement a lieu dans plusieurs cellules de la plage PL, sort de la procédure
If TEST = True Then Exit Sub 'si TEST est [Vrai], sort de la procédure (je préfère ça à EnableEvents = False)
If Not IsNumeric(Target.Value) Or 40 < Target.Value Or 1 > Target.Value Then 'condition : si la cellule modifié contient une valeur inférieure à 1 ou supérieure à 40
    MsgBox "Merci de saisir une valeur numérique comprise entre 1 et 40 !!! " 'message
    With Application 'prend en compte l'Application
        .EnableEvents = False 'n'autorise plus les procédures événementielles
        .Undo 'annule de vient d'être fait
        .EnableEvents = True 'autorise les procédure événementielles
    End With 'fin de la prise e compte de l'Apllication
End If 'fin de la condition
TEST = True 'définit la variable TEST
Target.Value = Target.Value \ 1 'si une valeur décimale est éditée, remplace par la valeur entière
If AV < Target.Value Then 'condition : si l'ancienne valeur de la cellule modifiée est inférieure à la nouvelle valeur
    LD = Target.Row + 1 'définit la ligne de départ LD
Else 'sinon
    For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
        'si la valeur de la cellule CEL est égale à la valeur de la cellule modifié et que leur adresse est différente,
        If CEL.Value = Target.Value And CEL.Address <> Target.Address Then LD = CEL.Row: Exit For 'définit la ligne de départ LD et sort de la boucle
    Next CEL 'prochaine cellule de la boucle
End If 'fin de la condition
'LF = IIf(AV > Target.Value, Target.Row - 1, Target.Row + 1) 'définit la ligne de fin LF en fonction de l'ancienne valeur (une ligne au-dessus ou au-dessous de la cellule modifiée)
If AV > Target.Value Then 'condition : si l'ancienne valeur de la cellule modifiée est inférieure à la nouvelle valeur
    LF = Target.Row - 1 'définit la ligne de départ LD
Else 'sinon
    For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
        'si la valeur de la cellule CEL est égale à la valeur de la cellule modifié et que leur adresse est différente,
        If CEL.Value = Target.Value And CEL.Address <> Target.Address Then LF = CEL.Row: Exit For 'définit la ligne de départ LD et sort de la boucle
    Next CEL 'prochaine cellule de la boucle
End If 'fin de la condition
For LI = LD To LF 'boucle sur toutes les ligne LI de LD à LF
    Cells(LI, 1).Value = IIf(AV > Target.Value, Cells(LI, 1).Value + 1, Cells(LI, 1).Value - 1) 'incrémente la cellule ligne Li colonne 1
Next LI 'prochaine ligne de la boucle
If Not Intersect(Target, PL) Is Nothing Then Tri 'lance la procédure [Tri]
Range("A1").Select 'sélectionne la cellule A1
TEST = False 'réinitialise la variable TEST
End Sub