XL 2016 Recopie d'un texte si valeur au croisement de colonne et ligne identique

[Jonathan08]

Bonjour à tous,

Désolé pour le titre de la discussion, je n'ai pas réussi à faire un résumé simple de ma problématique.

J'aimerai afficher un texte dans une cellule si les conditions sont réunis, et que ce soit applicable à l'ensemble d'un tableau.
la condition est :
Si des dates de la colonne "C" sont identiques aux dates en ligne "6" alors recopier le texte de la colonne "B".

Il y une formule toute simple pour afficher le texte si les conditions sont réunis :
Exemple en K8, si la valeur en C8 est identique à K6 alors afficher B8
=SI($C8=K$6;$B8;"")
sauf que comme ce sont de petites cellules et que tout le tableau est constitué de formule du même type, le texte est tronqué.
D'après ce que j'ai pu lire sur différents forums il n'est pas possible d’empêcher que le texte soit tronqué même si la formule suivante n'affiche rien.
Cela fonctionne dans l'exemple ci-dessus pour la 1ère ligne, parce que j'ai supprimé les formules qui suivent.

Si je ne suis pas clair n'hésitez pas à me le dire.

J'ai déjà cherché pas mal sur des forums, mais je n'ai pas trouvé de réponse sous forme de code VBA adaptable à ma demande.
je pourrai simplement me passer d'afficher le texte, mais je trouvais dommage de rester sur un échec.

Je vous remercie d'avance pour m'aider à résoudre ce problème.

 

[shinozak]

Bonjour,

Pq pas mettre directement le numéro de l'activité plutôt que toute la phrase ?

 

[Jonathan08]

Bonjour,
j'ai mis "résumé activité n°x" pour l'exemple et pour simplifier ma demande.
En vrai le texte est plus complexe et ne sera pas identique d'une ligne à l'autre.

 

[soan]

Bonjour Jonathan, shinozak,

ton fichier en retour ; fais Ctrl e ➯ travail effectué !

code VBA de Module1 (39 lignes) :

Option Explicit

Type Années: Y As Integer: B As Integer: End Type

Sub Activités()
  If Not IsDate([P2]) Then Exit Sub
  Dim dcl%: dcl = Cells(6, Columns.Count).End(1).Column: If dcl = 6 Then Exit Sub
  Dim dlg&: dlg = Cells(Rows.Count, 2).End(3).Row: If dlg = 6 Then Exit Sub
  Dim an(1 To 10) As Années, a%, n As Byte, d As Date, m As Byte, j As Byte
  Dim chn$, lig&, v%, c%, i%: a = Year([P2]) - 1: Application.ScreenUpdating = 0
  For i = 7 To dcl
    v = Year(Cells(6, i)): If v <> a Then n = n + 1: a = a + 1: an(n).Y = a: an(n).B = i
  Next i
  With Range([G7], Cells(dlg, dcl)): .ClearContents: .ClearComments: End With
  For lig = 7 To dlg
    With Cells(lig, 2)
      chn = .Value
      If chn <> "" Then
        If IsDate(.Offset(, 1)) Then
          d = .Offset(, 1): a = Year(d)
          For i = 1 To n
            If an(i).Y = a Then
              c = an(i).B: m = Month(d)
              Do While Month(Cells(6, c)) <> m And c <= dcl: c = c + 1: Loop
              If c <= dcl Then
                j = Day(d)
                Do While Day(Cells(6, c)) <> j And c <= dcl: c = c + 1: Loop
                If c <= dcl Then
                  With Cells(lig, c): .AddComment: .Comment.Text chn: End With
                End If
              End If
            End If
          Next i
        End If
      End If
    End With
  Next lig
End Sub

à te lire pour avoir ton avis.

soan

 

[soan]

Bonjour Jonathan,

sauf que comme ce sont de petites cellules et que tout le tableau est constitué de formule du même type, le texte est tronqué.
D'après ce que j'ai pu lire sur différents forums il n'est pas possible d’empêcher que le texte soit tronqué même si la formule suivante n'affiche rien.
Cela fonctionne dans l'exemple ci-dessus pour la 1ère ligne, parce que j'ai supprimé les formules qui suivent.

moi non plus, je ne connais pas de solution pour que le texte ne soit pas tronqué s'il y a une formule à côté ; et même, c'est pareil s'il y a un texte à côté sans qu'il soit le résultat d'une formule ; aussi, s'il y a à la fois une activité n° 1 qui débute le 8 juillet et une activité n° 2 qui débute le 9 juillet, il faudrait afficher les 2 textes côte à côte et en entier, ce qui n'est tout simplement pas possible, par manque de place ! ça équivaut à essayer de résoudre la quadrature du cercle ! c'est pourquoi j'ai choisi la solution de mon post #4 : mettre les textes en tant que commentaires de cellules ; je pense que c'est le choix le plus raisonnable, et que j'ai pu appliquer concrètement. même si tu essayais avec des Shapes (formes), ça serait bien plus compliqué, et je trouve que « le jeu n'en vaut pas la chandelle » !

si tu trouves une autre solution, pourquoi pas ? mais si tu ne trouves pas autre chose de mieux, ce serait sympa de ta part de marquer mon post #4 comme solution ; il suffit de cliquer sur la coche ✓ qui est sur le bord droit de mon post #4 : le fond de ce bord passera en vert, et dans la liste des sujets, il y aura cette même coche dans un cercle devant le texte « Réponses: ».​

soan

 

[Jonathan08]

Bonjour @soan

J'ai ajouté ce bout de code (trouvé sur le net) à ta proposition pour adapter la taille de la fenêtre commentaire à son contenu :

                    Dim xComment As Comment

                    For Each xComment In Application.ActiveSheet.Comments

                    xComment.Shape.TextFrame.AutoSize = True

aussi, s'il y a à la fois une activité n° 1 qui débute le 8 juillet et une activité n° 2 qui débute le 9 juillet, il faudrait afficher les 2 textes côte à côte et en entier, ce qui n'est tout simplement pas possible, par manque de place ! ça équivaut à essayer de résoudre la quadrature du cercle !

En fait cela ne peut arriver puisqu'il n'y a qu'une ligne de texte par période d'activité.

Comme j'ai pu te le dire, je te remercie pour ta proposition qui me donne une autre façon de solutionner la problématique, mais je me laisse un peu de temps pour essayer de copier le texte directement dans la cellule.
Si je n'y arrive pas (ce qui est fort probable ) je validerai ton post #4 comme solution.

merci à toi

Jonathan

 

[Jonathan08]

Merci à @soan d'avoir répondu si vite et avec une réponse adaptée à ma demande.
Juste, si tu peux me dire quel valeur changer pour que la recopie se fasse à partir d'une colonne plutôt qu'une autre (en l’occurrence c'était la colonne B).

Jonathan

 

[soan]

Bonjour Jonathan,

avec With Cells(lig, 2) c'est en colonne B ; si tu veux par exemple en colonne E : With Cells(lig, 5) ; pense aussi à adapter la ligne VBA d'effacement des cellules et des commentaires :​

With Range([G7], Cells(dlg, dcl)): .ClearContents: .ClearComments: End With

soan

 

[Jonathan08]

merci @soan