Mettre en gras avec condition

[Pascal]

Bonjour le Forum,
je veux mettre en gras des cellules qui contiennent des informations identiques sur une colonne (c'est des noms de produits);
je sais que pour mettre en gras une colonne:
Range('A2:A25').Select
Selection.Font.Bold = True
Mais moi je veux une boucle qui cherche les informations identiques.
j'arrive pas a mettre les conditions sur ma macro (de A2 à A25).
Merci pour l'aide.

 

[Hervé]

Bonjour pascal

peut etre comme ceci :

Sub Bouton2_QuandClic()
Dim c As Range
Dim plage As Range

Set plage = Range('a1:a' & Range('a65536').End(xlUp).Row)

For Each c In plage
        If WorksheetFunction.CountIf(plage, c) > 1 Then
                c.Font.Bold = True
        End If
Next c


End Sub

salut

 

[Pascal]

bonjour Hervé,
ca bloque au niveau:
c.Font.Bold = True
je ne c pas trops comment modifier ca...
Peut etre parce que je l'ai directement intégré dans une macro existente (j'ai bien sure enlever sub et end sub).
Je debute dans VB..

@+

 

[Hervé]

Re pascal

pourrais-tu nous montrer ta macro, car là je vois pas ce qui pourrait coincer



salut

 

[Pascal]

Re,
C un peu compliqué, parce que c une feuille de récap qui regroupe plusieurs informations avec des tableaux qui s'ajustes au contenu:

Sheets('detail avec comp').Select
For b = 19 To 103
If Range('b' & b) = '' Then
Rows(b & ':103').Select
Selection.EntireRow.Hidden = True
b = 103
Else
End If
Next b

For b = 112 To 195
If Range('b' & b) = '' Then
Rows(b & ':195').Select
Selection.EntireRow.Hidden = True
b = 195
Else
End If
Next b
Range('B196:I196').Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone


Dim c As Range
Dim plage As Range

Set plage = Range('a2:a' & Range('a65536').End(xlUp).Row)

For Each c In plage
If WorksheetFunction.CountIf(plage, c) > 1 Then
c.Font.Bold = True
End If
Next c
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

 

[Pascal]

et j'ai changé pour
Set plage = Range('a2:a' & Range('a65536').End(xlUp).Row)
la colonne a par b, parce que mes données sont en b.
A +

 

[Pascal]

et j'ai changé pour
Set plage = Range('a2:a' & Range('a65536').End(xlUp).Row)
la colonne a par b, parce que mes données sont en b.
A +

 

[Hervé]

re pascal

ceci fonctionne chez moi (j'ai un peu arrangé le code) :

Dim b As Integer
Dim c As Range
Dim plage As Range

Sheets('detail avec comp').Select

For b = 19 To 103
        If Range('b' & b) = '' Then
                Rows(b & ':103').EntireRow.Hidden = True
                Exit For 'permet de sortir de la boucle quand la condition est remplie
        End If
Next b

For b = 112 To 195
        If Range('b' & b) = '' Then
                Rows(b & ':195').EntireRow.Hidden = True
                Exit For
        End If
Next b

With Range('B196:I196')
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders.LineStyle = xlNone
        With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
        End With
End With

Set plage = Range('b2:b' & Range('b65536').End(xlUp).Row)

For Each c In plage
        If WorksheetFunction.CountIf(plage, c) > 1 Then
                c.Font.Bold = True
        End If
Next c

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

tu as remplacé le A par le B, tout les A ???

si tu as encore des soucis, pourrais-tu nous joindre un fichier plus détaillé.

salut

 

[Pascal]

salute hervé
Ca marche à merveille sous cette forme c excellent.
Merci