Nbr de cellule intermédiaire vide dans une colonne

[Ilino]

BONJOUR forum, MAPOMME, RACHID, PIER et les autres
Toujours dans le même principe du mon post précédent (la 1ere cellule vide dans une colonne ( formule&VBA) mais cette fois d’une autre façon
Comment faire un code VBA pour balayer une colonne (exemple A4 :A2012) de haut (1ere cellule remplie) vers le bas (dernière cellule remplie) afin de faire sortir toutes les adressses des cellules vide via un msgbox ou autre ??
Exemple :
A4 : toto
A5 : titi
A6 :
A7 :tata
A8 :
A9 :
A10 :fifi
A11 :fofo
A12
A13 :fafa (on considère que c’est la dernière ligne remplie)
A14
……ETC
A2012
Resultat : Msgbox(" VOUS AVEZ 04 CELLULES NON REMPLIE A6,A8,A9 et A12")

EST T IL POSSIBLE?
merci d'avance
RAMO ILINO

 

[mapomme]

Re : Nbr de cellule intermédiaire vide dans une colonne

Bonjour,

Testez le code suivant:

Sub test()
'---------------------------------------------
' Affiche l'adresse des cellules vides d'une colonne
' à partir d'une cellule donnée et
' jusqu'à la dernière cellule non vide de la colonne
'---------------------------------------------

Dim xRg As Range, xDep As Range, xRes

' cellule de départ
Set xDep = Range("h2")

' zone de la cellule de départ à la dernière cellule non vide de la colonne de xDEP
Set xRg = Cells(Rows.Count, xDep.Column).End(xlUp)

'Test si toutes les cellule sont vides
If xRg.Row < xDep.Row Then
    MsgBox "Toutes les cellules à partir de " & xDep.Address(False, False) & " sont vides."
ElseIf xRg.Row = xDep.Row Then
    If xDep = "" Then
        MsgBox "Toutes les cellules à partir de " & xDep.Address(False, False) & " (comprise) sont vides."
    Else
        MsgBox "Toutes les cellules à partir de " & xDep(2, 1).Address(False, False) & " sont vides."
    End If
Else
    ' recherche des cellules vides de la zone xRg
    On Error GoTo AucuneVide:
    Set xRg = Range(xDep, xRg).SpecialCells(xlCellTypeBlanks)
    Set xRg = xRg.SpecialCells(xlCellTypeBlanks)
    'Affichage des adresses des zones de cellules vides
    MsgBox xRg.Count & " cellules vides : " & xRg.Address(False, False)
    'ou bien
    'Affichage de l'adresse de chaque cellule cellule vide
    For Each xDep In xRg
     xRes = xRes & " , " & xDep.Address(False, False)
     Next xDep
     MsgBox xRg.Count & " cellule(s) vide(s) : " & Right(xRes, Len(xRes) - 1)
End If
Exit Sub

AucuneVide:
    MsgBox ("Aucune cellule vide.")
End Sub

Edit: 02:15: correction des erreurs si cellule de départ sur ligne 1.

 

[ROGER2327]

Re : Nbr de cellule intermédiaire vide dans une colonne

Bonjour à tous

Une autre façon de voir les choses :

Private Sub BoutonTest_Click()
    MsgBox compteVide(Range("A4:A2012").Cells)
End Sub

Private Function compteVide$(Plg As Range)
Dim oPlg As Range, vPlg As Range, vArs As Range, Msg$, n&, s$
    Application.Volatile
    Set oPlg = Intersect(Plg, Columns(Plg(1).Column).Resize(Cells(Me.Rows.Count, Plg(1).Column).End(xlUp).Row))
    On Error Resume Next
    If Not oPlg Is Nothing Then Set vPlg = Intersect(oPlg, oPlg.SpecialCells(xlCellTypeBlanks))
    On Error GoTo 0
    Set oPlg = Nothing
    If vPlg Is Nothing Then
        Msg = "Aucune cellule vide."
    Else
        For Each vArs In vPlg.Areas
            n = n + vArs.Count
            s = s & vArs.Address(0, 0) & ","
            If Len(s) < 60 Then s = s & " " Else Msg = Msg & s & vbLf: s = ""
        Next vArs
        Msg = n & " cellule" & IIf(n > 1, "s", "") & " vide" & IIf(n > 1, "s", "") & " :" & vbLf & vbLf & Left$(Msg & s, Len(Msg & s) - 2) & "."
    End If
    Set vPlg = Nothing
    compteVide = Msg
End Function

(Code placé dans le module de la feuille concernée.)​

ROGER2327
#5469

Dimanche 15 Gueules 139 (Alice au Pays des Merveilles - fête Suprême Tierce)
20 Pluviôse An CCXX, 1,0862h - serpette
2012-W06-4T02:36:25Z

 

[Ilino]

Re : Nbr de cellule intermédiaire vide dans une colonne

Forum BONJOUR, MAPOMME,ROGER JE VOUS SALUT
Merci pour votre code , les deux codec fonctioonent comme je veux donc je doi faire un choix...
un gros merci pour vous les meux

 

[Ilino]

Re : Nbr de cellule intermédiaire vide dans une colonne

Bonjour,

Testez le code suivant:

Sub test()
'---------------------------------------------
' Affiche l'adresse des cellules vides d'une colonne
' à partir d'une cellule donnée et
' jusqu'à la dernière cellule non vide de la colonne
'---------------------------------------------

Dim xRg As Range, xDep As Range, xRes

' cellule de départ
Set xDep = Range("h2")

' zone de la cellule de départ à la dernière cellule non vide de la colonne de xDEP
Set xRg = Cells(Rows.Count, xDep.Column).End(xlUp)

'Test si toutes les cellule sont vides
If xRg.Row < xDep.Row Then
    MsgBox "Toutes les cellules à partir de " & xDep.Address(False, False) & " sont vides."
ElseIf xRg.Row = xDep.Row Then
    If xDep = "" Then
        MsgBox "Toutes les cellules à partir de " & xDep.Address(False, False) & " (comprise) sont vides."
    Else
        MsgBox "Toutes les cellules à partir de " & xDep(2, 1).Address(False, False) & " sont vides."
    End If
Else
    ' recherche des cellules vides de la zone xRg
    On Error GoTo AucuneVide:
    Set xRg = Range(xDep, xRg).SpecialCells(xlCellTypeBlanks)
    Set xRg = xRg.SpecialCells(xlCellTypeBlanks)
    'Affichage des adresses des zones de cellules vides
    MsgBox xRg.Count & " cellules vides : " & xRg.Address(False, False)
    'ou bien
    'Affichage de l'adresse de chaque cellule cellule vide
    For Each xDep In xRg
     xRes = xRes & " , " & xDep.Address(False, False)
     Next xDep
     MsgBox xRg.Count & " cellule(s) vide(s) : " & Right(xRes, Len(xRes) - 1)
End If
Exit Sub

AucuneVide:
    MsgBox ("Aucune cellule vide.")
End Sub

Edit: 02:15: correction des erreurs si cellule de départ sur ligne 1.

Re bonjour
une remarque pour le code de ma pomme: le msgbox s'affiche deux fois??
THINKS
RAMO ILINO

OK C'est bon j'ai compris pourquoi..JE retire ma question
MERCI