Mettre en gras

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

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

Merci GVIALLES mais il ne se passe rien.

Bonjour Benoist28200,

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

Rechercher des sujets similaires à "mettre gras"