Mettre en gras
B
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
B
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?