Nbr de cellule intermédiaire vide dans une colonne

Ilino · 9 Février 2012

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 · 9 Février 2012

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

Bonjour,

Testez le code suivant:

Code:

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 · 9 Février 2012

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

Bonjour à tous

Une autre façon de voir les choses :

VB:

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 · 9 Février 2012

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 · 9 Février 2012

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

mapomme à dit:

Bonjour,

Testez le code suivant:

Code:

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

Nbr de cellule intermédiaire vide dans une colonne

Ilino

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

Pièces jointes

Ilino

XLDnaute Barbatruc

Ilino

XLDnaute Barbatruc

Discussions similaires