Nombres de lignes contenues dans un même répertoire

Le 21/10/2018 à 08:26

Bonjour tout le monde !

J'ai un répertoire avec plusieurs fichiers qui ont un point commun une page appelé "DONNEES"

Je sais qu'il est possible de compter le nombre de fichiers excel dans le même répertoire...

Peut on compter le nombre de lignes contenues dans ce répertoire avec la cellules "A" pleine ou compter les cellules pleines dans la colonne A de tous ces fichiers ?

Merci d'avance...Bon dimanche.

Le 21/10/2018 à 09:19

Bonjour,

Voici une piste, adapter le chemin du dossier dans la proc "Test()" puis l'exécuter. Le résultat sera inscrit dans la fenêtre d'exécution (Ctrl+G depuis le VBE) :

Sub Test()

    Dim Tbl() As String
    Dim NomFe As String
    Dim Chemin As String
    Dim I As Integer

    'adapter le chemin du dossier
    Chemin = "D:\Dossier\Sous Dossier\" '<------

    'nom des feuilles
    NomFe = "DONNEES"

    'récup des noms des fichiers
    Tbl = EnumFichiers(Chemin)

    'si initialisé...
    If Not (Not Tbl) Then

        'boucle sur le tableau avec résultat dans la fenêtre d'exécution (Ctrl+G)
        For I = 1 To UBound(Tbl)

            Debug.Print "La colonne A de la feuille 'DONNEES' du classeur " & _
                        Tbl(I) & _
                        " contient " & _
                        DerCel(Chemin, Tbl(I), NomFe) & " lignes non vides !"

        Next I

    End If

End Sub

Function DerCel(Dossier As String, Classeur As String, NomFe As String) As Long

    Dim Cel As Long

    'recherche la dernière ligne non vide de la colonne A (avec pour maximum 65536 lignes, adapter si plus !)
    Cel = ExecuteExcel4Macro("COUNTA('" & Dossier & _
                             "[" & Classeur & "]" & _
                             NomFe & "'!R1C1:R65536C1)")

    DerCel = Cel

End Function

Function EnumFichiers(Chemin As String) As String()

    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer

    'complète le chemin le cas échéant
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"

    'récupère seulement les fichiers Excel
    Fichier = Dir(Chemin & "*.xls*")

    'boucle sur les fichiers du dossier
    Do While (Len(Fichier) > 0)

        I = I + 1: ReDim Preserve TableauFichiers(1 To I)
        TableauFichiers(I) = Fichier

        Fichier = Dir()

    Loop

    'retourne le tableau des noms de fichiers
    EnumFichiers = TableauFichiers()

End Function
Le 21/10/2018 à 10:03

Bonjour merci pour ta réponse:

Mais ça me met

La colonne A de la feuille 'DONNEES' du classeur extrait_20_10_2018.xlsm contient 65536 lignes non vides !

Alors qu'il y a 32 lignes non vides soit 31 si j’enlève l entête de mon tableau, mais ça j'ai corrigé avec :

    Cel = ExecuteExcel4Macro("COUNTA('" & Dossier & _
                             "[" & Classeur & "]" & _
                             NomFe & "'!R2C1:R65536C1)")

J'ai corrigé xls par xlm

L'objectif serait de faire la somme des lignes non vide et la récupérer dans une variable genre total

msgbox total

pour ensuite l'exploiter ...

Merci, ton code est impressionnant

Le 21/10/2018 à 17:17

Re,

Pour le total, voici une piste. J'ai rajouté une fonction pour contrôler si la feuille existe dans le classeur en cours :

Sub Test()

    Dim tbl() As String
    Dim NomFe As String
    Dim Chemin As String
    Dim I As Integer
    Dim Total As Long

    'adapter le chemin du dossier
    Chemin = "D:\Dossier\Sous Dossier\" '<------

    'nom des feuilles
    NomFe = "DONNEES"

    'récup des noms des fichiers
    tbl = EnumFichiers(Chemin)

    'si initialisé...
    If Not (Not tbl) Then

        'boucle sur le tableau avec résultat dans la fenêtre d'exécution (Ctrl+G)
        For I = 1 To UBound(tbl)

            Total = Total + DerCel(Chemin, tbl(I), NomFe)

        Next I

        MsgBox Total

    End If

End Sub

Function DerCel(Dossier As String, Classeur As String, NomFe As String) As Long

    Dim Cel As Long

    'contrôle si la feuille existe dans le classeur
    If FeuilleExiste(Dossier & Classeur, NomFe) Then

        'recherche la dernière ligne non vide de la colonne A (avec pour maximum 65536 lignes, adapter si plus !)
        Cel = ExecuteExcel4Macro("COUNTA('" & Dossier & _
                                 "[" & Classeur & "]" & _
                                 NomFe & "'!R1C1:R65536C1)")

    End If

    DerCel = Cel

End Function

Public Function FeuilleExiste(Fichier As String, NomFeuille As String) As Boolean

    Dim Cat As Object
    Dim tbl As Object
    Dim Nom As String

    Set Cat = CreateObject("ADOX.Catalog")
    Set tbl = CreateObject("ADOX.Table")

    'pour Excel 2003
'    Cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
'                       Fichier & _
'                       ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=2;"""

    'pour Excel 2007
    Cat.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
                       Fichier & _
                       ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=2;"""

    'passe les feuilles en revue et récupère leurs nom sans le dollar
    'dans un tableau
    For Each tbl In Cat.Tables

        Nom = Replace(tbl.Name, "$", "")
        If Nom = NomFeuille Then FeuilleExiste = True: Exit For

    Next

    Set tbl = Nothing

End Function

Function EnumFichiers(Chemin As String) As String()

    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer

    'complète le chemin le cas échéant
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"

    'récupère seulement les fichiers Excel
    Fichier = Dir(Chemin & "*.xls*")

    'boucle sur les fichiers du dossier
    Do While (Len(Fichier) > 0)

        I = I + 1: ReDim Preserve TableauFichiers(1 To I)
        TableauFichiers(I) = Fichier

        Fichier = Dir()

    Loop

    'retourne le tableau des noms de fichiers
    EnumFichiers = TableauFichiers()

End Function
Le 21/10/2018 à 18:02

bonjou rà tous

sans une seule ligne de code,

menu Données Obtenir de classeur (naviguer vers ton classeur)

"charger"

tu obtiens un long tableau avec tout

il te suffit de faire un TCD de comptage

pas de VBA

cadeau : il n'y a aucune formule non plus

amitiés

Le 23/10/2018 à 20:18

Bonsoir, ça fonctionne super bien !

Un grand Merci Theze !

Le 24/10/2018 à 06:27

Bonjour,

Content de t'avoir aidé

Rechercher des sujets similaires à "nombres lignes contenues meme repertoire"