Mettre en gras et en couleurs des mots - Exclure des cellules d'un filtre

Le 23/03/2022 à 09:48

Bonjour,

Je suis novice dans les macros et j'ai quelques difficultés pour une problématique qui je pense devrait être réalisable.

Je vous explique, j'ai besoin d'imprimer pour mon équipe de production, la feuille "Liste col" de mon fichier.
Pour qu'ils aient + de facilité, nous avons déjà une série de filtre et données mis en évidence avec des changements macro. (je reprends ce fichier d'un ancien collaborateur et essaie d'y ajouter des nouveautés).

Pour l'instant, la feuille "Liste col" est triée par ordre alphabétique par rapport à la colonne des références de nos articles (colonne B).
J'aimerais que toutes les lignes de cette feuille dont les cellules de la colonne D contiennent "BRILLANT" ou "PROTECTION" ne soient pas concernée par ce tri.
Il faudrait pour bien faire, que toutes les lignes qui contiennent ces mots en colonne D soient répertoriées en fin de feuille.
Encore mieux, si en fin de feuille, toutes ces lignes contenant ces mots seraient retriées par ordre alphabétique en fonction toujours de cette colonne B. (je ne sais pas si cette dernière étape est réalisable).

Egalement, j'ai mis en gras certains termes avec le code suivant :

' remplacer des termes '

Columns("D:D").Replace "|Finition:Mat", ""
Columns("D:D").Replace "|Couche protectrice:Sans", ""
Columns("D:D").Replace "Finition:Brillant", "BRILLANT"
Columns("D:D").Replace "Couche protectrice:Plastification premium", "PROTECTION"

' mettre BRILLANT et PROTECTION en gras '
mot = "BRILLANT"
For Each c In Range("D2:D" & [D65000].End(xlUp).Row)
p = InStr(UCase(c), UCase(mot))
If p > 0 Then c.Characters(Start:=p, Length:=Len(mot)).Font.Bold = True
Next c

mot = "PROTECTION"
For Each c In Range("D2:D" & [D65000].End(xlUp).Row)
p = InStr(UCase(c), UCase(mot))
If p > 0 Then c.Characters(Start:=p, Length:=Len(mot)).Font.Bold = True
Next c

J'aimerais pouvoir rajouter une couleur sur les mots "BRILLANT" et "PROTECTION", du rouge par exemple.

Cordialement,

Kévin

Le 23/03/2022 à 09:56

Bonjour Kevcharlier et

Une petite présentation ICI serait la bienvenue

Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum et notamment

Je regarde le fichier envoyé par lien en MP (car trop lourd et avec données personnelles)

Merci de votre participation

Cordialement

Le 23/03/2022 à 10:51

Re,

Dans le fichier bon nombre de Sub peuvent être regroupées dans un même module
et beaucoup sont vides, peuvent être supprimés (click droit)

Sinon voici le code pour effectuer le tri comme demandé

Sub TriListeCol()
  Dim dLig As Long, Lig As Long
  With ThisWorkbook.Sheets("Liste col")
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Désactiver les évènements
    Application.EnableEvents = False
    ' Parcourir les lignes et modifier la ref de celles avec BRILLANT ou PROTECTION
    For Lig = 2 To dLig
      If InStr(1, .Range("D" & Lig), "BRILLANT") > 0 Or _
        InStr(1, .Range("D" & Lig), "PROTECTION") > 0 Then
        ' Modifier la référence temporairement
        .Range("B" & Lig).Value = "Z_" & .Range("B" & Lig).Value
      End If
    Next Lig
    ' Réactiver les évènements
    Application.EnableEvents = True
    ' Trier
    With .Sort
      With .SortFields
        .Clear
        .Add2 Key:=Range("B2:B" & dLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      End With
      .SetRange Range("A1:D" & dLig)
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
    ' Remettre les ref à la normal
    .Range("B2:B" & dLig).Replace What:="Z_", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
  End With
End Sub

Pour ce qui concerne la couleur, voici

  ' mettre BRILLANT et PROTECTION en gras et en ROUGE '
  mot = "BRILLANT"
  For Each c In Range("D2:D" & [D65000].End(xlUp).Row)
    p = InStr(UCase(c), UCase(mot))
    If p > 0 Then
      With c.Characters(Start:=p, Length:=Len(mot)).Font
        .Bold = True
        .Color = 255
      End With
    End If
  Next c

  mot = "PROTECTION"
  For Each c In Range("D2:D" & [D65000].End(xlUp).Row)
    p = InStr(UCase(c), UCase(mot))
    If p > 0 Then
            With c.Characters(Start:=p, Length:=Len(mot)).Font
        .Bold = True
        .Color = 255
      End With
    End If
  Next c

A tester

A+

Le 23/03/2022 à 13:00

Re,

Oui en effet, j'ai repris le document en ma possession hier seulement et j'ai remarqué qu'il faudrait mettre dans de l'ordre dans tout cela, dans un premier temps, je vais résoudre ma problématique et j'y reviendrai.

Merci pour votre aide, le tri fonctionne bien, les cellules de la colonne D contenant "BRILLANT" ou "PROTECTION" s'affiche bien plus bas et également par odre alphabétique en colonne B !

J'aurais une dernière petite demande si c'est possible, je voudrais que tout les "BRILLANT|PROTECTION " , "BRILLANT " et "PROTECTION" soient groupé ensemble les un en dessous des autres en colonne D.

Vous pourrez voir sur la capture d'écran suivante, il faudrait que les lignes contenant "BRILLANT|PROTECTION" se suivent, pareil pour celles contenant "BRILLANT" et également pour celle contenant "PROTECTION".

Merci beaucoup pour votre aide !

capture d e cran 2022 03 23 a 12 55 16
Le 23/03/2022 à 14:05

Re,

Comme on fait un classement alphabétique, c'est compliqué

J'essaye de voir, mais pas certain

A+

Le 23/03/2022 à 14:35

Re,

Voici un code à essayer

Sub TriListeCol()
  Dim dLig As Long, Lig As Long
  Dim Deb As Long, sTmp As String
  Dim Sht As Worksheet
  ' Désactiver les évènements
  Application.EnableEvents = False
  ' Définir la feuille de travail
  Set Sht = ThisWorkbook.Sheets("Liste col")
  ' Dernière ligne remplie
  dLig = Sht.Range("A" & Rows.Count).End(xlUp).Row
  ' Parcourir les lignes et modifier la ref de celles avec BRILLANT ou PROTECTION
  For Lig = 2 To dLig
    ' Si la cellule de la colonne D contient les arguments
    If InStr(1, Sht.Range("D" & Lig), "BRILLANT") > 0 Or _
                                                  InStr(1, Sht.Range("D" & Lig), "PROTECTION") > 0 Then
      ' Copier les ref en colonne E
      Sht.Range("E" & Lig).Value = Sht.Range("B" & Lig).Value
      ' Récupérer le libellé de la référence
      sTmp = Sht.Range("D" & Lig).Value
      ' Trouver la première occurence de BRILLANT ou PROTECTION
      Deb = InStr(1, sTmp, "|")
      Do While Mid(sTmp, Deb + 1, 2) <> "BR" And Mid(sTmp, Deb + 1, 2) <> "PR"
        Deb = InStr(Deb + 1, sTmp, "|")
      Loop
      ' Modifier la référence temporairement en inscrivant une peudo référence
      Sht.Range("B" & Lig).Value = "Z_" & Mid(sTmp, Deb)
    End If
  Next Lig
  ' Trier
  With Sht.Sort
    With .SortFields
      .Clear
      .Add2 Key:=Sht.Range("B2:B" & dLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With
    ' On tri les colonnes A à E (référence si BRILLANT ou PROTECTION)
    .SetRange Sht.Range("A1:E" & dLig)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
  ' Remettre les ref à la normal
  '.Range("B2:B" & dLig).Replace What:="Z_", Replacement:="", LookAt:=xlPart, _
  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
  ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
  ' Parcourir les lignes
  For Lig = 2 To dLig
    ' Si la colonne E contient une référence
    If Sht.Range("E" & Lig) <> "" Then
      ' La remettre à sa place
      Sht.Range("B" & Lig).Value = Sht.Range("E" & Lig).Value
      ' Effacer la colonne E
      Sht.Range("E" & Lig).ClearContents
    End If
  Next Lig
  ' Effacer la variable objet
  Set Sht = Nothing
  ' Réactiver les évènements
  Application.EnableEvents = True
End Sub

A+

Le 24/03/2022 à 13:55

Bonjour Bruno,

Un énorme merci pour ton aide, cela fonctionne parfaitement !

J'ai juste un petit problème, quand je clique sur "CLICK ALL" (module 40), tout les boutons présent sur la feuille "Boutons" s'exécutent.

Le problème est que le code que vous m'avez transmis ne s'exécute pas, il ne s'exécute que lorsque je reclique sur le bouton "GENERER LISTE COL" (module 32).

Voici le fichier en pièce jointe.

Le 24/03/2022 à 14:09

Re,

Vous ne devez/pouvez pas déposer sur ce forum un fichier avec des données personnelles

Revoyez votre code de transformation de "|Finition:Brillant" en "|BRILLANT"

Voici ce que j'ai avant exécution du code donné

image

Ce n'est pas ce que j'avais sur le précédent

Je recherche le caractère "|" dans la cellule, si je le trouve, je vérifie si les 2 caractères d'après sont "BR" ou "PR"

Ce qui du coup, n'est absolument pas le cas.

A+

Le 24/03/2022 à 14:30

Oui justement, en cliquant sur le bouton "GENERER LISTE COL" de la première feuille après avoir cliqué sur "CLICK ALL", cela résou le problème. C'est cela que je ne comprends pas, normalement "click all" devrait exécuter correctement tout le "GENERER LISTE COL", la ce n'est pas le cas.

PS: ce sont des données de liste de production, ce n'est pas sensible du tout.

Le 24/03/2022 à 14:32

Re,

kevcharlier a écrit :

PS: ce sont des données de liste de production, ce n'est pas sensible du tout.

Et les adresses mail

Le 24/03/2022 à 15:15

En effet, il n'y en avait pas beaucoup car j'avais justement raccourci mon fichier avec juste qq tests, dans celui-ci, je viens de modifier les données au hasard.

Désolé pour le fichier précédent.

9template-pour-etiquettes-xlsm.zip (899.80 Ko)
Rechercher des sujets similaires à "mettre gras couleurs mots exclure filtre"