VBA remplissage de cellules vides sous conditions

[actaris51]

Bonjour,
Voilà, sous Excel, j'ai trois colonnes, B C et D, qui peuvent etre cochées suivant les lignes (on met un "X" dans la cellule)
par exemple, en B1 j'ai un "X" et rien en C1 et D1, en B2 et en C2 j'ai un X mais rien en D2.
Mais parfois, il n'y a rien de coché (exemple : B3, C3 et D3 sont vides)
J'aimerai que dans le cas ou les trois cellules de la ligne sont vides, alors les 3 cellules en question soient cochées.

Pouvez vous m'aider ?

Merci

 

[Robert]

Re : VBA remplissage de cellules vides sous conditions

Bonsoir Actaris, bonsoir le forum,

En pièce jointe un fichier commenté avec une macro sur le bouton Action.
Le code :

Private Sub CommandButton1_Click() 'bouton "Action"
Dim dl As Integer 'déclare la varialbe dl (Dernière Ligne)
Dim col As Byte 'déclare la variable col (COLonne)
Dim li As Integer 'déclare la variable li (LIgne)
Dim cel As Range 'déclare la variable cel (CELlule)
 
For col = 2 To 4 'boucle sur les colonnes 2 à 4
    'définit la variable dl
    'si la dernière ligne de la colonne est supérieur à dl alors dl est égal à la dernière ligne de la colonne
    If Cells(65536, col).End(xlUp).Row > dl Then dl = Cells(65536, col).End(xlUp).Row
Next col 'prochaine colonne de la boucle
 
For li = 1 To dl 'boucle 1: sur toutes les lignes du tableau
    For Each cel In Range(Cells(li, 2), Cells(li, 4)) 'boucle 2 : sur les trois cellules de la ligne
        If cel.Value <> "" Then GoTo suite 'si la cellule n'est pas vide va à la ligne suivante via l'étiquette "suite"
    Next cel 'prochaine cellule de la boucle 2
    Range(Cells(li, 2), Cells(li, 4)).Value = "x" 'remplit les 3 cellules vides de "x"
suite: 'étiquette
Next li 'prochaine ligne de la boucle 1
End Sub

 

[Staple1600]

Re : VBA remplissage de cellules vides sous conditions

Bonsoir à tous


Une autre façon avec emploi du filtre élaboré

Sub Mettre_X()
Dim p As Range
With [B1]
        .Offset(1, 3).FormulaLocal = "=NB.VIDE(B2:D2)=3"
        .Resize([D65536].End(xlUp).Row, 3).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("E1:E2"), Unique:=False
    Set p = Range("_FilterDataBase")
        With p.Offset(1).SpecialCells(xlCellTypeVisible)
            .Value = "X"
            .Font.Bold = True
        End With
    .Offset(1, 3) = Empty
End With
ActiveSheet.ShowAllData
End Sub