Mettre en gras

Y compris Power BI, Power Query et toute autre question en lien avec Excel
B
Benoist28200
Membre fidèle
Membre fidèle
Messages : 391
Inscrit le : 28 octobre 2015
Version d'Excel : 2013 FR

Message par Benoist28200 » 26 décembre 2017, 17:26

Bonjour le forum,

J'ai ce code qui me permet de fusionner les cellule identiques:

Est-il possible de faire en sorte que si la valeur de la colonne G = "N" alors la valeur de la colonne E se mette en gras ? Merci
Dim a
   Dim i As Long, j As Long, n As Long
   
   a = Sheets("BaseCours").Cells(1).CurrentRegion.Value
   
   'On utilise un Dictionnaire pour traiter les valeurs uniques
   With CreateObject("Scripting.Dictionary")
      .CompareMode = 1
      For i = 1 To UBound(a, 1)
         If Not .exists(a(i, 1)) Then  'nouvel item
            n = n + 1            'compteur
            .Item(a(i, 1)) = n
            For j = 1 To UBound(a, 2)
               a(n, j) = a(i, j)
            Next
         Else  'item existe, on combine les données de la colonne E / G
            a(.Item(a(i, 1)), 5) = Join(Array(a(.Item(a(i, 1)), 5), a(i, 5)), vbLf)
            a(.Item(a(i, 1)), 7) = Join(Array(a(.Item(a(i, 1)), 7), a(i, 7)), vbLf)
         End If
      Next
   End With
   
   'On recopie les résultats dans  feuille ("Enr")
   Sheets("Enr").Cells.Clear

   With Sheets("Enr").Cells(1).Resize(n, UBound(a, 2))
      For i = 1 To n 'nombre de ligne = notre compteur
         For j = 1 To UBound(a, 2)
            .Cells(i, j).Value = a(i, j)
         Next
      Next
      ' Ajuster les lignes et colonnes
      .VerticalAlignment = xlTop
      .Columns.ColumnWidth = 150
      .Columns.AutoFit
      .Rows.AutoFit
   End With
Avatar du membre
GVIALLES
Membre dévoué
Membre dévoué
Messages : 816
Appréciations reçues : 73
Inscrit le : 28 novembre 2017
Version d'Excel : 2016, 360
Téléchargements : Mes applications

Message par GVIALLES » 26 décembre 2017, 17:39

Bonjour Benoist28200,

Je propose l'aménagement suivant :
Dim a
   Dim i As Long, j As Long, n As Long
   
   a = Sheets("BaseCours").Cells(1).CurrentRegion.Value
   
   'On utilise un Dictionnaire pour traiter les valeurs uniques
   With CreateObject("Scripting.Dictionary")
      .CompareMode = 1
      For i = 1 To UBound(a, 1)
         If Not .exists(a(i, 1)) Then  'nouvel item
            n = n + 1            'compteur
            .Item(a(i, 1)) = n
            For j = 1 To UBound(a, 2)
               a(n, j) = a(i, j)
            Next
         Else  'item existe, on combine les données de la colonne E / G
            a(.Item(a(i, 1)), 5) = Join(Array(a(.Item(a(i, 1)), 5), a(i, 5)), vbLf)
            a(.Item(a(i, 1)), 7) = Join(Array(a(.Item(a(i, 1)), 7), a(i, 7)), vbLf)
         End If
      Next
   End With
   
   'On recopie les résultats dans  feuille ("Enr")
   Sheets("Enr").Cells.Clear

   With Sheets("Enr").Cells(1).Resize(n, UBound(a, 2))
      For i = 1 To n 'nombre de ligne = notre compteur
         For j = 1 To UBound(a, 2)
            .Cells(i, j).Value = a(i, j)
            'Proposition GVS ############################
            If j = 5 Then 'Colonne E
                If a(i, 7) = "N" Then
                    .Cells(i, j).Font.Bold = True
                Else
                    .Cells(i, j).Font.Bold = False
                End If
            End If
            '############################################
         Next
      Next
      ' Ajuster les lignes et colonnes
      .VerticalAlignment = xlTop
      .Columns.ColumnWidth = 150
      .Columns.AutoFit
      .Rows.AutoFit
   End With
Cordialement,

Gérard
B
Benoist28200
Membre fidèle
Membre fidèle
Messages : 391
Inscrit le : 28 octobre 2015
Version d'Excel : 2013 FR

Message par Benoist28200 » 26 décembre 2017, 17:53

Merci GVIALLES mais il ne se passe rien.
Avatar du membre
GVIALLES
Membre dévoué
Membre dévoué
Messages : 816
Appréciations reçues : 73
Inscrit le : 28 novembre 2017
Version d'Excel : 2016, 360
Téléchargements : Mes applications

Message par GVIALLES » 27 décembre 2017, 09:34

Bonjour Benoist28200,

Pouvez-vous envoyer une version exemple du classeur, afin que je puisses faire les tests?
Cordialement,

Gérard
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message