Souligner automatiquement si 2 conditions sont remplies

Je cherche un moyen pour qu’Excel fasse une mise en forme l’intérieur d’une cellule si 2 conditions sont successivement remplies.

Il s’agit de souligner automatiquement des textes dans des cellules sans avoir à resélectionner et souligner manuellement les textes.

Il faudrait qu’Excel vérifie si le caractère « – » (tiret demi-cadratin) est présent dans la cellule. Si oui, vérifier si on trouve aussi le caractère « : » (deux points).

Si oui, alors souligner tout le texte commençant 2 caractères après le tiret et jusqu’au 2 points.

Si un crack en VBA peut m’aider, merci à lui (ou elle) !

Tu aurais du regrouper toutes tes demandes en un post... Et clairement définir ta demande dès le début sans rajouter au fur et à mesure de nouvelles choses.

Cordialement

En fait il s'agit de demandes assez distinctes – et les besoins ne sont pas apparus au même moment.

Je gère des feuilles très compliquées et compactes. Tout ce qui peut en améliorer la lisibilité m'aide beaucoup, mais si je dois gérer les mises en forme "à la main", ça devient un boulot interminable et contreproductif.

D'où l'idée de recourir au VBA. Mais comme je ne suis qu'un bidouilleur, je ne peux que faire appel à plus expérimenté que moi.

J'espère que ces qqes explications t'aideront à comprendre.

Bonjour ou Re

Une idée sur la base d'un fichier que tu as déjà

Génial !!!!

Juste un truc : ton code implique d'appuyer sur un bouton pour déclencher la mise en forme.

Est-ce que tu pourrais faire en sorte que la mise en forme s'applique dès que le contenu d'une cellule est modifié, sans intervention "manuelle" ?

En tous cas, merci beaucoup, ça va me faire gagner du temps et de l'efficacité.

Bonsoir

Devines .... une nouvelle version

Le fait de modifier une cellule souligne (ou non) dans cette cellule uniquement, sinon cela risque de prendre trop de temps si la plage à modifier (à chaque modification de cellule) est importante

Si non à la prochaine

C'est parfait, génial, impeccable : merci merci à mon bienfaiteur !

J'ai même réussi à adapter le code à plusieurs feuilles concernées.

En revanche, pour l'une d'entre elles, j'ai déjà du code qui commence par :

Private Sub Worksheet_Change(ByVal Target As Range

et Excel n'aime pas. J'obtiens le message : "Erreur de compilation : nom ambigu détecté : Worksheet_Change"

Comment faire pour contourner cette difficulté ?

Re

Vérifie dans chaque code de feuille il ne peut y avoir qu'un

Private Sub Worksheet_Change(ByVal Target As Range)

Si une deuxième procédure est identique il faudra les réunir dans la même

Merci pour ta réponse.

Je suis coincé, car j'ai besoin à la fois du code pour souligner automatiquement et de celui qui identifie en rouge un texte recherché :

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = Range("ad16").Address Then
    Recherche (Target.Text)
  End If
End Sub
___________________________________________________

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Pos1 As Integer
Dim Pos2 As Integer

  If Target.Address = Range("C6").Address Then
    Recherche (Target.Text)
  ElseIf Not Intersect(Range("h9:h" & Range("h65536").End(xlUp).Row), Target) Is Nothing Then
    With Cells(Target.Row, 8)
      Pos1 = 0
      Pos2 = 0
      Do
        Pos1 = InStr(Pos1 + 1, .Text, "–")
        If Pos1 > 0 Then
          Pos2 = InStr(Pos1, .Text, ":")
          If Pos2 > 0 Then
            .Characters(Start:=Pos1 + 2, Length:=Pos2 - (Pos1 + 1)).Font.Underline = xlUnderlineStyleSingle
          End If
        End If
      Loop Until Pos1 = 0
    End With
  End If
End Sub

Comment faire pour les faire coexister ?

(désolé de te harceler de questions)

Bonjour,

Comme tu ne testes pas la même cellule dans les deux cas tu dois pouvoir réunir tes 2 actions dans un seul code, on teste d'abord AD16, appel de Recherche puis sortie (Exit Sub), ensuite on teste C6, etc.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = Range("ad16").Address Then
    Recherche (Target.Text)
    Exit Sub
  End If

Dim Pos1 As Integer
Dim Pos2 As Integer

  If Target.Address = Range("C6").Address Then
    Recherche (Target.Text)
  ElseIf Not Intersect(Range("h9:h" & Range("h65536").End(xlUp).Row), Target) Is Nothing Then
    With Cells(Target.Row, 8)
      Pos1 = 0
      Pos2 = 0
      Do
        Pos1 = InStr(Pos1 + 1, .Text, "–")
        If Pos1 > 0 Then
          Pos2 = InStr(Pos1, .Text, ":")
          If Pos2 > 0 Then
            .Characters(Start:=Pos1 + 2, Length:=Pos2 - (Pos1 + 1)).Font.Underline = xlUnderlineStyleSingle
          End If
        End If
      Loop Until Pos1 = 0
    End With
  End If
End Sub
 

A+

Re

Modifies la deuxième

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Pos1 As Integer
    Dim Pos2 As Integer

      If Target.Address = Range("ad16").Address Then
        Recherche (Target.Text)
      ElseIf Not Intersect(Range("h9:h" & Range("h65536").End(xlUp).Row), Target) Is Nothing Then
        With Cells(Target.Row, 8)
          Pos1 = 0
          Pos2 = 0
          Do
            Pos1 = InStr(Pos1 + 1, .Text, "–")
            If Pos1 > 0 Then
              Pos2 = InStr(Pos1, .Text, ":")
              If Pos2 > 0 Then
                .Characters(Start:=Pos1 + 2, Length:=Pos2 - (Pos1 + 1)).Font.Underline = xlUnderlineStyleSingle
              End If
            End If
          Loop Until Pos1 = 0
        End With
      End If
    End Sub
     

et supprime la première

Cool : ça marche !

Bravo aux virtuoses du VBA et merci beaucoup !

Même cause, mêmes effets : je voudrais ajouter une 3è macro dans le code de la page (cf sujet : https://forum.excel-pratique.com/excel/detection-auto-de-textes-pour-les-mettre-en-gras-t19972-20.html )

, mais elle commence aussi par

   Private Sub Worksheet_Change

Je ne sais pas comment on fait pour "l'agglomérer" au code déjà présent sans déclencher une erreur de type :

Erreur de compilation : Nom ambigu détecté : Worksheet_Change

Voilà le code de la page :

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = Range("ad16").Address Then
    Recherche (Target.Text)
    Exit Sub
  End If

Dim Pos1 As Integer
Dim Pos2 As Integer

  If Target.Address = Range("C6").Address Then
    Recherche (Target.Text)
  ElseIf Not Intersect(Range("h9:h" & Range("h65536").End(xlUp).Row), Target) Is Nothing Then
    With Cells(Target.Row, 8)
      Pos1 = 0
      Pos2 = 0
      Do
        Pos1 = InStr(Pos1 + 1, .Text, "–")
        If Pos1 > 0 Then
          Pos2 = InStr(Pos1, .Text, ":")
          If Pos2 > 0 Then
            .Characters(Start:=Pos1 + 2, Length:=Pos2 - (Pos1 + 1)).Font.Underline = xlUnderlineStyleSingle
          End If
        End If
      Loop Until Pos1 = 0
    End With
  End If
End Sub

Quelqu'un pourrait-il m'aider à faire ça siouplé ?

Merci !!!

Merci encore à tous ceux qui ont contribué à répondre à ma demande de code pour souligner automatiquement du texte si 2 conditions sont remplies, ça m'aide beaucoup dans mon boulot.

Un problème est apparu à l'usage : le soulignement automatique ne se fait plus quand la cellule contient plus de 1030 caractères (voir fichier joint).

Quelqu'un saurait-il comment faire pour éviter ce bug ?

Merci !

...personne n'a d'inspiration pour contourner le "mur" des 1030 caractères ?

Bonjour

Comme je ne sais (plus) ce que tu as comme macro, joins un fichier avec des cellules avec plus de 1030 caractères

Afin d'essayer de trouver une solution

A suivre

Bonne journée

Merci pour ta réponse.

Bonjour

Compressé il prend moins de place (généralement c'est le cas )

A voir

Merci beaucoup, ça marche parfaitement.

Respect !

Bizarrement, depuis quelques jours, la super macro de Banzai64 ne marche plus, que ce soit dans le fichier auquel je l'avais adapté ou dans le fichier qu'il avait envoyé.

Est-ce qu'il y a un paramètre à régler dans Excel pour que ça remarche ?

D'avance merci !