Macro pour inscrire un libellé dans certaines cellules sous conditions...

[Christian0258]

Bonjour à tout le forum,

Je souhaiterais l'aide des spécialistes en VBA afin d'écrire une macro...comme indiqué dans le libellé ci-dessus...

voir fichier

Je vous remercie pour votre aide.

Bien à vous,
Christian

 

[JBARBE]

Re : Macro pour inscrire un libellé dans certaines cellules sous conditions...

Bonjour à tous,

Si j'ai bien compris peut-être ceci qui va jusqu’à la ligne 50 et qui peut être modifié !

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([M7:X50], Target) Is Nothing Then
        Target = "compatible"
 ElseIf Not Intersect([Y7:AD50], Target) Is Nothing Then
        Target = "autorisé"
  End If
End Sub

bonne soirée

 

[Christian0258]

Re : Macro pour inscrire un libellé dans certaines cellules sous conditions...

Re, le forum, JBARBE,

Merci, JBARBE, pour ton aide et le travail, mais ce n'est pas ce que j'attends.

En fait, je souhaite qu'après avoir inscrit "compatible" ou "autorisé" (voir fichier joint post1), selon les deux zones, je clique sur un bouton et que s'inscrivent ; "incompatible" ou "autorisé", dans les cellules vides (de la zone renseignée, comme expliqué préalablement).

Bien à vous.
A vous lire,
Christian

 

[JBARBE]

Re : Macro pour inscrire un libellé dans certaines cellules sous conditions...

En cliquant sur le bouton inserer la macro remplie les cellules vides ou vide les cellules concernées pleines !


bonne soirée

 

[Christian0258]

Re : Macro pour inscrire un libellé dans certaines cellules sous conditions...

Re, le forum, JBARBE,

C'est parfaitement, parfait.

Je te remercie infiniment, JBARBE, pour le boulot.

Bien à toi,
Christian

 

[Christian0258]

Re : Macro pour inscrire un libellé dans certaines cellules sous conditions...

Re, le forum, JBARBE,

Je reviens vers vous, car après essais, il y a un critère qui n'est pas pris en compte, dans ta macro JBARBE, c'est la zone de traitement qui doit être conditionnée au remplissage de la colonne F:
-dans mon fichier initial j'indique que la zone à traiter peut aller jusqu'à la ligne 50 si la colonne F est renseignée, c'est donc la colonne F qui détermine la zone de traitement...dans l'exemple le traitement va jusqu'à la ligne 14 mais dans l'absolu il peut aller jusqu'à la ligne 50 (donc la zone à traiter est fluctuante)

Merci pour votre aide.
Bien amicalement,
Christian

 

[Christian0258]

Re : Macro pour inscrire un libellé dans certaines cellules sous conditions...

Re, bonjour à tout le forum, JBARBE,

Pour compléter les explications de mon dernier post, je joins, ici, le fichier avec les explications réitérer...

Merci pour votre aide, si précieuse.

Bien à vous,
Christian

 

[job75]

Re : Macro pour inscrire un libellé dans certaines cellules sous conditions...

Bonjour Christian, JBARBE,

Avec des tableaux VBA c'est nettement plus rapide.

Et avec une macro paramétrée c'est plus propre :

Sub Insère()
Dim tablo
tablo = [F7:F50] 'matrice, plus rapide
Macro tablo, [M7:X50], "incompatible"
Macro tablo, [Y7:AD50], "interdit"
End Sub

Sub Macro(tablo, zone As Range, mot$)
Dim t, ncol%, i&, vide As Boolean, j%
t = zone 'matrice, plus rapide
ncol = UBound(t, 2)
For i = 1 To UBound(t)
  vide = tablo(i, 1) = ""
  For j = 1 To ncol
    If vide Then
      t(i, j) = ""
    ElseIf t(i, j) = "" Then
      t(i, j) = mot
    ElseIf t(i, j) = mot Then
      t(i, j) = ""
    End If
  Next
Next
zone = t
End Sub

Fichier joint.

A+

 

[Christian0258]

Re : Macro pour inscrire un libellé dans certaines cellules sous conditions...

Re, le forum, JBARBE, job75,

Merci, job75, pour le boulot. C'est parfaitement, parfait...comme d'hab...

Bien à vous,
Christian

 

[job75]

Re : Macro pour inscrire un libellé dans certaines cellules sous conditions...

Re,

Je préfère la version (1) mais cette version (2) n'est pas mal :

Sub Insère()
Dim tablo As Range, z1 As Range, z2 As Range, t1$, t2$, z As Range, n&
Set tablo = [F7:F50]: Set z1 = [M7:X50]: Set z2 = [Y7:AD50]
t1 = "incompatible": t2 = "interdit"
Set z = Union(z1, z2)
On Error Resume Next
Intersect(z, tablo.SpecialCells(xlCellTypeBlanks).EntireRow).ClearContents
Set z = Intersect(z, tablo.SpecialCells(xlCellTypeConstants).EntireRow)
Set z1 = Intersect(z1, z): Set z2 = Intersect(z2, z)
n = Application.CountIf(z1, t1) + Application.CountIf(z2, t2)
z1.Replace IIf(n, t1, ""), IIf(n, "", t1), xlWhole
z2.Replace IIf(n, t2, ""), IIf(n, "", t2)
End Sub

En terme de rapidité elles sont équivalentes : 3,6 et 3,8 millisecondes.

A+

 

[Christian0258]

Re : Macro pour inscrire un libellé dans certaines cellules sous conditions...

Re, le forum, job75,

Merci , l'ami, pour cette version que je garde de côté...

C'est pas normal, autant de talent sur une seule personne....lol

Bien à toi,
Christian

 

[job75]

Re : Macro pour inscrire un libellé dans certaines cellules sous conditions...

Bonjour Christian, le forum,

Cette version (2 bis) va mieux si F7:F50 est complètement vide :

Sub Insère()
Dim tablo As Range, z1 As Range, z2 As Range, t1$, t2$, z As Range, n&
Set tablo = [F7:F50]: Set z1 = [M7:X50]: Set z2 = [Y7:AD50]
t1 = "incompatible": t2 = "interdit"
Set z = Union(z1, z2)
On Error Resume Next
Intersect(z, tablo.SpecialCells(xlCellTypeBlanks).EntireRow).ClearContents
Err.Clear
Set z = Intersect(z, tablo.SpecialCells(xlCellTypeConstants).EntireRow)
If Err Then Exit Sub
Set z1 = Intersect(z1, z): Set z2 = Intersect(z2, z)
n = Application.CountIf(z1, t1) + Application.CountIf(z2, t2)
z1.Replace IIf(n, t1, ""), IIf(n, "", t1), xlWhole
z2.Replace IIf(n, t2, ""), IIf(n, "", t2)
End Sub

Edit : je viens de tester avec F7:F50 entièrement remplie, y a pas photo :

- version (1) => 4,9 millisecondes

- versions (2) ou (2 bis) => 26 millisecondes.

Bonne journée.