Affichage conditionne

  • Initiateur de la discussion Initiateur de la discussion Ilino
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Ilino

XLDnaute Barbatruc
Bonjour Forum
je vous solicye encore 😱
J’au un tableau qui commence de la ligne 12 et se termine ligne 33 ( ligne 11 c’est l’entete du tableau les titres) ,dans ma colonne G(fusionnée G-K) c’est une colonne des dates , je souhaite préparer un code VBA qui affiche un MsgBox si une des dates de la colonne G12 dépasse une date de référence ( cellule AQ7) alors afficher « la date Ob a dépassée la date DES »
A+
 
Re : Affichage conditionne

Bonjour à tous_______________________EDITION:Bonjour Gardien de phare


Ilino
Il faudra te conseiller combien de fois de joindre un fichier exemple pour que cela devienne un automatisme chez toi quand tu poses une question sur le forum ?
 
Dernière édition:
Re : Affichage conditionne

Bonjour à tous,

L'ami Ilino, peux-tu essayer :

Code:
Option Explicit

Sub Test()
Dim X%
For X = 12 To 33
If Cells(X, "G") > Range("AQ7") Then
MsgBox "La date Ob " & Cells(X, "G") & " en " & Cells(X, "G").Address & " a dépassé la date DES", vbCritical, "Information"
End If
Next X
End Sub

Comme déjà écrit, con un file, è meglio...

A+ à tous
 
Re : Affichage conditionne

Bonjour Ilino, Jean-Marie, Gardien de phare,

@ Jean-Marie : un fichier exemple n'est vraiment pas nécessaire pour si peu...

@ Gardien de phare : toi aussi tu succombes à la phobie (courante sur XLD) des cellules fusionnées 🙄

@ Ilino : sur l'autre fil je t'ai fourni une macro Worksheet_Change, tu peux la compléter de 2 manières :

1) manière autoritaire :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Variant, r As Range
c = [AQ7] 'référence de date, à adapter
Set r = Intersect(Target, [G12:G33])
If r Is Nothing Then Exit Sub
For Each r In r
  If r = "" Then Union(r(1, -4), r(1, 6).Resize(, 9)) = ""
  If c <> "" And r > c Then _
    MsgBox "Date non valide en " & r.Address(0, 0) & _
      ", elle va être effacée...": r = ""
Next
End Sub
2) manière diplomatique comme les aiment les italiens :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Variant, r As Range
c = [AQ7] 'référence de date, à adapter
Set r = Intersect(Target, [G12:G33])
If r Is Nothing Then Exit Sub
For Each r In r
  If r = "" Then Union(r(1, -4), r(1, 6).Resize(, 9)) = ""
  If c <> "" And r > c Then _
    If MsgBox("Date non valide en " & r.Address(0, 0) & _
      ", voulez-vous l'effacer ?", 4) = 6 Then r = ""
Next
End Sub
Edit : hello Jean-Claude, heureux de te croiser 🙂

A+
 
Dernière édition:
Re : Affichage conditionne

Re,

On peut aussi, et c'est mieux, utiliser une macro Worksheet_SelectionChange :

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim d As Variant, r As Range
d = [AQ7] 'référence de date, à adapter
For Each r In [G12:G33]
  If d <> "" And r > d Then _
    If MsgBox("Date non valide en " & r.Address(0, 0) & _
      ", voulez-vous l'effacer ?", 4) = 6 Then r = ""
  If r = "" Then Union(r(1, -4), r(1, 6).Resize(, 9)) = ""
Next
End Sub
Pas besoin de tester Target, vu qu'il y a très peu de cellules traitées la macro s'exécute en quelques millièmes de seconde.

A+
 
Re : Affichage conditionne

Bonjour Ilino, Jean-Marie, Gardien de phare,


2) manière diplomatique comme les aiment les italiens :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Variant, r As Range
c = [AQ7] 'référence de date, à adapter
Set r = Intersect(Target, [G12:G33])
If r Is Nothing Then Exit Sub
For Each r In r
  If r = "" Then Union(r(1, -4), r(1, 6).Resize(, 9)) = ""
  If c <> "" And r > c Then _
    If MsgBox("Date non valide en " & r.Address(0, 0) & _
      ", voulez-vous l'effacer ?", 4) = 6 Then r = ""
Next
End Sub
Edit : hello Jean-Claude, heureux de te croiser 🙂

A+
@ Job : Questa è la soluzione migliore.😎
@ JCGL : Sì, hai ragione.😱

In ogni caso, grazie a tutti.
A+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
10
Affichages
766
Réponses
0
Affichages
420
Réponses
0
Affichages
550
Retour