Microsoft 365 Macro : effacer colonne suite à changement de valeur

[Viro_Major]

Bonsoir,

J’aimerais placer une macro à la racine de ma feuille

Imaginons une plage B10:B20, et une case B13 remplie par la valeur ”x”.

J’aimerais que si j’entre une valeur (admettons “o”) dans n’importe quelle case de la plage B10:B20 , celà efface d’abord toutes les valeurs de la plage puis ne garde que la nouvelle que j’entre (exemple “o” en case B15 si je frappe en B15)

J’ai essayé diverses formules mais celà tourne généralement en boucle jusqu’à crasher le soft.

Merci d’un éventuel coup de main...

 

[soan]

Bonjour Viro_Major,

Vos désirs sont des ordres, sergent-major !

Je te laisse essayer le fichier joint ci-dessous.

PS : désolé pour le retard de ma réponse,
j'viens seulement d'revenir de perm !

soan

 

[Viro_Major]

Bonjour moussaillon @soan ! Fidèle au poste, vous faites parti du meilleur des troupes !

Toutefois, il n’est pas l’heure de rompre les rangs, nous y sommes presque mais pas tout à fait.

Ta proposition est un modèle d’efficacité léchée, en dehors du fait, qu’au lieu d’effacer toutes les valeurs de la plage avant de ne laisser que la dernière dans la case visée, et bien celà copie la valeur entrée sur toutes les cellules de la plage...

Il faudrait d’abord effacer toutes les valeurs de la plage et ne laisser que la nouvelle dans la case que nous modifions.

J’ai tenté de modifier ton code pour

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  With Target
    If .CountLarge > 1 Then Exit Sub
    If Intersect(Target, [I5:I533]) Is Nothing Then Exit Sub
    Application.ScreenUpdating = 0: Application.EnableEvents = 0
    [I5:I533].ClearContents
    If .Value <> "" Then ActiveCell = .Value
    Application.EnableEvents = -1
  End With
End Sub

Mais du coup, il ne reste plus rien, pas même la dernière valeur que j’entre dans la case que je cible.

Une double ration vous sera octroyé si vous menez la mission à bout soldat ! ...Merci encore

 

[soan]

J'suis un moussaillon qui a très faim, alors j'espère que la cantine du mess
est bien achalandée ! voici de quoi obtenir ma double ration :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim plg As Range, vx$
  With Target
    If .CountLarge > 1 Then Exit Sub
    Set plg = [I5:I30]: If Intersect(Target, plg) Is Nothing Then Exit Sub
    Application.ScreenUpdating = 0: Application.EnableEvents = 0
    vx = .Value: If vx <> "" Then plg.ClearContents: .Value = vx
    Application.EnableEvents = -1
  End With
End Sub

en I5:I30 : "o" ; cellule active : I14 ; saisis par exemple "a" ➯ I5:I30 est effacé,
reste seulement "a" en I14 ; ça aurait fait pareil si tu avais saisi dans une autre
cellule de la plage I5:I30 ; petite cerise sur le gâteau : ta plage réelle n'est pas
I5:I30 ? mon nouveau code fait que tu n'as besoin de modifier la plage qu'à
un seul endroit : change Set plg = [I5:I30] en Set plg = [I5:I533] ; comment ?
je peux rompre les rangs, et j'ai droit à une triple ration ? merci, chef !

soan

 

[Viro_Major]

Triple ration délivrée , et exceptionnellement, permissions pour manger avec les doigts et les pieds sur la table accordées ! Merci et bon weekend

 

[soan]

ok pour tout, bon weekend à toi aussi !

soan

 

[soan]

Suite à ton message privé de 14:08, voici un fichier pour 2 plages différentes.

* ta 1ère plage est I5:I533
* ta 2ème plage est O6:O533 ; vérifie si ça n'est pas plutôt O5:O533

* dans le fichier joint, j'ai simplifié avec I5:I30 et O6:O30 ; j'ai quand même mis O6.

* en I12, saisis par exemple c ; en O16 par exemple, saisis par exemple d

attention : dans le code VBA, j'ai mis un commentaire important !

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim plg As Range, vx$
  With Target
    If .CountLarge > 1 Then Exit Sub
    Application.ScreenUpdating = 0: Application.EnableEvents = 0
    '1ère plage------------------------------------------------------
    Set plg = [I5:I30]
    If Not Intersect(Target, plg) Is Nothing Then
      vx = .Value: If vx <> "" Then plg.ClearContents: .Value = vx
      GoTo 1 'évite de tester la 2ème plage qui est dessous,
      'et va à l'étiquette 1 pour réactiver les événements
    End If
    '2ème plage------------------------------------------------------
    Set plg = [O6:O30]
    If Not Intersect(Target, plg) Is Nothing Then
      vx = .Value: If vx <> "" Then plg.ClearContents: .Value = vx
    End If
  End With
1 Application.EnableEvents = -1
End Sub

soan

 

[Viro_Major]

Merci. Intéressant ! J’apprends

 

[soan]

Pour le code VBA de ton message privé de 14:25, je l'ai optimisé comme ci-dessous.

Note bien tout ceci :

A) il y a 2 instructions GoTo 1

B) les 2 plages I5:I533 et O6:O533 sont testées en premier ; donc ça évite de les indiquer
dans la longue plage qui sert pour le 3ème Intersect()

C) afin d'éviter une ligne de code très longue pour indiquer la plage du 3ème Intersect(),
j'ai ajouté la variable chn$ et l'ai utilisée avec le caractère souligné « _ » de continuation
de ligne + l'opérateur de concaténation « & »

D) il y a une instruction GoTo 2 car il ne faut pas oublier que les événements ont été
désactivés juste au-dessus de la 1ère plage (c'est à droite du gel de l'écran) ; donc surtout,
ne pas sortir via Exit Sub et aller à l'étiquette 2 pour réactiver les événements

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim plg As Range, chn$, vx$
  With Target
    If .CountLarge > 1 Then Exit Sub
    Application.ScreenUpdating = 0: Application.EnableEvents = 0
    '1ère plage -----------------------------------------------------
    Set plg = [I5:I533]
    If Not Intersect(Target, plg) Is Nothing Then
      vx = .Value: If vx <> "" Then plg.ClearContents: .Value = vx
      GoTo 1
    End If
    '2ème plage -----------------------------------------------------
    Set plg = [O6:O533]
    If Not Intersect(Target, plg) Is Nothing Then
      vx = .Value: If vx <> "" Then plg.ClearContents: .Value = vx
      GoTo 1
    End If
    'autre plage ----------------------------------------------------
    chn = "R3, X3, AD3, AD5, C2, I3, O4, U5, AA6, B4, F4, " _
      & "C4, U7:U533, AA8:AA533"
    If Intersect(Target, Range(chn)) Is Nothing Then GoTo 2
1   .Offset(-1).Select '1 ligne plus haut
2   Application.EnableEvents = -1
  End With
End Sub

soan