Sélection de cellules spécifiques

[RollyLCXL]

Bonjour,

Dans une plage je cherche à sélectionner que les cellules avec le format "0.00".

J'utilise …

Feuil1.Range("A1:Z100").SpecialCells(xlCellTypeFormulas, 1).Select afin de sélectionner

mais ça sélectionne les cellules avec les formats "0.00" mais aussi "General".

Y-aurait il moyen de pouvoir sélectionner que les cellules en "0.00"?

Merci à l'avance.

 

[mapomme]

Bonjour RollyLCXL et bienvenue sur XLD,

Une piste dans le fichier joint (code dans module1).

Hélas! La version v1 souffrait d'une limitation dans le nombre de cellules qu'on pouvait sélectionner. Préférez la v2.

Voir ICI la version corrigée v2.

 

[eriiic]

Bonjour,

ou recherche par format pour ne pas à avoir toutes les cellules à balayer :

Sub test()
    MsgBox cherche_Format([A1:Z100], "0.00").Address
End Sub
Function cherche_Format(plage As Range, formatCh As String) As Range
    Dim c1 As Range, pl As Range, adr1 As String
    Application.FindFormat.Clear
    Application.FindFormat.NumberFormat = formatCh
    Application.ScreenUpdating = False
    Set c1 = plage.Find(What:="", LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=True)
    If c1 Is Nothing Then Exit Function
    adr1 = c1.Address
    Do
        If pl Is Nothing Then Set pl = c1 Else Set pl = Union(pl, c1)
        Set c1 = plage.Find(What:="", After:=c1, LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=True)
        If c1.Address <> adr1 Then
           
        End If
    Loop While Not c1 Is Nothing And c1.Address <> adr1
    Set cherche_Format = pl
End Function

eric

 

[mapomme]

Bonjour à tous,

Ma précédente version (v1) était limitée quant au nombre de cellules qu'on pouvait sélectionner.

Préférer cette version v2.

 

[zebanx]

Bonjour à tous,

Très intéressant pour pouvoir sélectionner des cellules qui respectent un certain format.
Je pensais, à tort, que findformat pouvait permettre de le faire en un nombre de lignes très limitée (car c'est assez court pour faire un "replace") mais ce n'est pas le cas, c'est bien de l'apprendre avec deux approches un peu différente.

Bravo à Mapomme et Eriiic pour ces deux codes utiles.

Bonne journée
zebanx

 

[eriiic]

moi aussi je passe à la V2

Ajout possibilité de choisir également la couleur fond et police (optionnel) :

Sub test()
    Dim pl As Range, msg As String
    ' sélectionner format "0.00" écrit en rouge
    Set pl = cherche_Format([A1:Z100], "0.00", , RGB(255, 0, 0))
    ' sélectionner format "0.00" en rouge sur fond vert
    Set pl = cherche_Format([A1:Z100], "0.00", vbGreen, RGB(255, 0, 0))
    If pl Is Nothing Then msg = "Nothing" Else msg = pl.Address
    MsgBox msg
End Sub
Function cherche_Format(plage As Range, Optional formatNombre, Optional interiorColor, Optional fontColor) As Range
    Dim c1 As Range, pl As Range, adr1 As String, ok As Boolean
    Application.FindFormat.Clear
    If Not IsMissing(formatNombre) Then Application.FindFormat.NumberFormat = formatNombre: ok = True
    If Not IsMissing(interiorColor) Then Application.FindFormat.Interior.Color = interiorColor: ok = True
    If Not IsMissing(fontColor) Then Application.FindFormat.Font.Color = fontColor: ok = True
    If ok Then
        Set c1 = plage.Find(What:="", LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=True)
        If c1 Is Nothing Then Exit Function
        adr1 = c1.Address
        Do
            If pl Is Nothing Then Set pl = c1 Else Set pl = Union(pl, c1)
            Set c1 = plage.Find(What:="", After:=c1, LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=True)
            If c1.Address <> adr1 Then
            End If
        Loop While Not c1 Is Nothing And c1.Address <> adr1
    End If
    Set cherche_Format = pl
End Function

eric

 

[RollyLCXL]

Un grand merci. Super!