Index Equiv dans Macro - réalisable

Bonjour à tous,

J'ai bien avancé grâce a pas mal de tuto et vos aides pour mon suivi de formation.

Je demandais la dernière fois si il y avait un moyen pour consolider et additionner des valeurs issu de 365 documents dans un unique.

Plusieurs solutions me sont parvenu. L'utilisation de Power Query, mais je ne me suis pas fait la main dessus encore.

Et je viens de penser si ça me prends un peu de temps mais qu'après je suis tranquille c'est parfait, l'utilisation d'une macro qui ferait un Index/Equiv. avec une addition de tout les fichiers ? Est-ce jouable ?

Voici mes documents.

Ils portent tous le noms : jj.mm.aaaa.

Seule les lignes changent.

Et mon BILAN 2019, dans lequel je souhaiterais que cela s'additionne.

Merci de votre aide.

OU je peux faire consolider.

Fonction : Somme

Reference : Equiv(Index...)

Et dans les référence je souhaiterai qu'il aille chercher tous les documents excel enregistré dans un fichier.

Possible ça ?

bonjour

avec PQuery

on peut aller plus loin, mais... es-tu certain que les noms des personnes resteront toujours dans les mêmes colonnes des 365 fichiers ?

amitiés

je pense que si les noms ne sont pas stables dans chaque fichier, il faut dépivoter les données avant de concaténer les fichiers

Et oui la est le dilemme !!!!

Si j'ai des modifications de personnel c'est plus complexe.

jmd a écrit :

bonjour

avec PQuery

on peut aller plus loin, mais... es-tu certain que les noms des personnes resteront toujours dans les mêmes colonnes des 365 fichiers ?

amitiés

OK jmd pour l'utilisation de Power Querty pour faire figurer le tout dans le feuille 2 ensuite il faudrait que je puisse récupérer ces données pour les faire figurer dans mes feuilles déjà crée.

re

si l'extraction avec concaténation que j'ai faite ci-dessus te convient, il faut faire un TCD et le filtrer

quand ça marche, tu copies ce TCD 10 fois et tu le filtres sur 10 valeurs différentes

moi, je préfère un unique TCD avec un filtre que le lecteur peut ajuster selon ses besoins

amitiés

bonjour,

une autre solution possible via macro. Macro à lancer via alt-F8.

Sub aargh()
    Set twb = ThisWorkbook
    With Application.FileDialog(msoFileDialogFolderPicker) 'choix du répertoire
        .AllowMultiSelect = False
        .Title = "Choisir le répertoire contenant les fichiers à consolider"
        If .Show = True Then
            rep = .SelectedItems(1) & "\"
        Else
            Exit Sub
        End If
    End With

    anac = Val(InputBox("année à consolider")) 'choix de l'année à consolider
    If Len(anac) < 4 Then anac = 2000 + anac
    If anac = 0 Then Exit Sub

    nf = rep & "*.*." & Format(anac, "0000") & ".xls*"
    nf = Dir(nf)

    While nf <> "" 'on examine les fichiers de l'année qui ont le format *.*.année.xls*

    Application.StatusBar = "consolidation fichier " & nf
        Application.DisplayAlerts = False
        Set wb = Workbooks.Open(rep & nf) 'ouverture du fichier
        Set ws = wb.Sheets("bulletin") 'selection du bulletin
        Application.DisplayAlerts = True
        dl = ws.Cells(Rows.Count, 1).End(xlUp).Row

        For i = 4 To dl ' pour chaque ligne du bulletin
            ns = ws.Cells(i, 1)
            If ns = "" Then Exit For
            Set wst = twb.Sheets(ns) 'on ouvre l'onglet correspondant à la spécialité
            dlt = wst.Cells(4, 1).End(xlDown).Row
            Set plagewst = wst.Range("A4:A" & dlt)
            Set re = plagewst.Find(ws.Cells(i, 2), lookat:=xlWhole) 'on recherche la technique dans l'onglet de la spécialité

            If re Is Nothing Then 'si pas trouvée on l'ajoute
                wst.Rows(dlt).Copy
                wst.Rows(dlt + 1).Insert Shift:=xlDown
                dlt = dlt + 1
                wst.Cells(dlt, 1) = ws.Cells(i, 2)
                q = dlt
            Else
                q = re.Row
            End If

            dc = ws.Cells(i, Columns.Count).End(xlToLeft).Column

            For j = 3 To dc 'on compte les personnes qui ont participé
                If ws.Cells(i, j) <> "" Then
                    'hypothèse : les personnes sont toujours dans la même colonne (sur un bulletin ou dans la synthèse sur chaque feuille)
                    wst.Cells(q, j) = wst.Cells(q, j) + 1
                End If
            Next j

        Next i
        wb.Close
        nf = Dir
    Wend

    Application.StatusBar = ""
End Sub

Salut H2SO4

désolé du retard. Ouiiiiiii on y est !!!!! c'est ca que je cherchais depuis longtemps.

Mais ca fonctionne pas tres bien et je ne comprends pas le code.

J'ai du inserer une colonne dans chaque feuille parce que en effet ça vient dessus mais décalé.

Par ailleurs j'ai quelques soucis avec l'addition

En fait, si ca fonctionne mais il faut que j'efface le contenu des cellules, sinon l'addition ne se fait pas bien.

Ca me compte un en plus a chaque fois bizarre.

Ce code m’intéresse beaucoup!, il me serait d'une grande utilité pour d'autres doc que j'envisage de construire!!!! j'aimerais bien le maîtriser ligne par ligne

Merci beaucoup H2SO4

bonsoir

En fait, si ca fonctionne mais il faut que j'efface le contenu des cellules, sinon l'addition ne se fait pas bien.

Ca me compte un en plus a chaque fois bizarre.

en effet, la macro ne prévoit pas de remise à zero des onglets spécialités, d'où des résultats bizarres si tu ne les remets pas à zero, avant de lancer une synthèse.

Ok ça je sais faire des l’ouverture une petite macro qui efface les plages. Rien de compliqué.

Excellent déjà de pouvoir réaliser ta macro.

Par contre, est ce possible que cette macro puisse reconnaître les noms des personnels? Comme tu disais en commentaire de macro hypothèse les personnels sont toujours dans la même colonne.

Et si j’ai des changements ? Ça peut m’arriver. Le personnel 7 monte dans la hiérarchie et se retrouve à la place du personnel 2?

bonjour,

version adaptée pour personnel qui ne serait pas toujours dans la même colonne

Sub aargh()
'voici l'algorithme :

'1) choisir le répertoire
'2) choisir l'année
'3) parcourir tous les fichiers du répertoire pour cette année qui ont le bon format *.*.annee.xls
'4) ouvrir le fichier
'5) parcourir toutes les lignes du bulletin
'6) trouver dans synthèse l'onglet de la spécialité pour cette ligne
'7) trouver dans cet onglet, l'activité pour cette ligne
'8) si activité n'existe pas on l'ajoute
'9) parcourir toutes les colonnes de cette ligne du bulletin
'10) si valeur 1 détectée, 
'  10.1) on recherche la personne dans l'onglet spécialité
'  10.2) si trouvé on ajoute 1 au compteur de cette personne pour cette activité
'11) on passe à la colonne suivante ->10)
'12) on passe à la ligne suivante ->6)
'13) on ferme le fichier 
'14) on passe au fichier suivant ->4)

    Set twb = ThisWorkbook
    With Application.FileDialog(msoFileDialogFolderPicker)    'choix du répertoire
        .AllowMultiSelect = False
        .Title = "Choisir le répertoire contenant les fichiers à consolider"
        If .Show = True Then
            rep = .SelectedItems(1) & "\"
        Else
            Exit Sub
        End If
    End With
    anac = Val(InputBox("année à consolider"))    'choix de l'année à consolider
    If Len(anac) < 4 Then anac = 2000 + anac
    If anac = 0 Then Exit Sub
    nf = rep & "*.*." & Format(anac, "0000") & ".xls*"
    nf = Dir(nf)
    While nf <> ""    'on examine les fichiers de l'année qui ont le format *.*.année.xls*
        Application.StatusBar = "consolidation fichier " & nf
        Application.DisplayAlerts = False
        Set wb = Workbooks.Open(rep & nf, UpdateLinks:=False)   'ouverture du fichier
        Set ws = wb.Sheets("bulletin")    'selection du bulletin
        Application.DisplayAlerts = True
        dl = ws.Cells(Rows.Count, 1).End(xlUp).Row
        For i = 4 To dl    ' pour chaque ligne du bulletin
            ns = ws.Cells(i, 1)
            If ns = "" Then Exit For
            Set wst = twb.Sheets(ns)    'on ouvre l'onglet correspondant à la spécialité
            dlt = wst.Cells(4, 1).End(xlDown).Row
            Set plagewst = wst.Range("A4:A" & dlt)
            Set re = plagewst.Find(ws.Cells(i, 2), lookat:=xlWhole)    'on recherche la technique dans l'onglet de la spécialité
            If re Is Nothing Then    'si pas trouvée on l'ajoute
                wst.Rows(dlt).Copy
                wst.Rows(dlt + 1).Insert Shift:=xlDown
                dlt = dlt + 1
                wst.Cells(dlt, 1) = ws.Cells(i, 2)
                q = dlt
            Else
                q = re.Row
            End If
            dc = ws.Cells(i, Columns.Count).End(xlToLeft).Column
            For j = 3 To dc    'on compte les personnes qui ont participé
                If ws.Cells(i, j) <> "" Then
                    'recherche du nom dans l'onglet spécialité
                    Set re = Range(wst.Range("D3"), wst.Cells(3, dc)).Find(ws.Cells(3, j), lookat:=xlWhole, LookIn:=xlValues)
                    If re Is Nothing Then
                        MsgBox "personnel " & ws.Cells(3, j) & " non trouvé dans l'onglet " & ws.Name
                    Else
                        wst.Cells(q, re.Column) = wst.Cells(q, re.Column) + 1
                    End If
                End If
            Next j
        Next i
        wb.Close
        nf = Dir
    Wend
    Application.StatusBar = ""
End Sub

Merci beaucoup pour ta rapidité H2SO4, je travaille dessus cette après midi. J'aimerais tellement avoir un cours perso sur cette macro histoire de la maitriser sur le bout des doigts. Allez je m'y penche de suite !

bonjour,

algorithme ajouté dans le code

re

h2so4,

pourquoi faire ces explications en texte, alors qu'il est 1000 fois mieux de les mettre en commentaires dans le code ?

(si complexe, tu peux même mettre un résumé +/- détaillé en tête de code)

amitiés

Bonjour,

tu as tout à fait raison, mais j'estime que je ne dois pas toujours tout faire à la place du demandeur. Ceci dit, pour ce cas-ci, j'ai fait l'adaptation pour te faire plaisir.

trop sympa

ceci dit, c'est pas pour faire plaisir, mais pour montrer les bonnes pratiques

car les bonnes pratiques, c'est 50% d'un résultat

amitiés

Merci à vous deux!

H2SO4, tes commentaires dans le code m'ont été d'une grande importance ! J'apprends beaucoup mieux comme ça .

J'ai un soucis avec le personnel 1, il ne me le trouve pas dans les bulletins.

bonjour,

J'ai un soucis avec le personnel 1, il ne me le trouve pas dans les bulletins.

ton souci est dû à un bug

corrige cette instruction ainsi

'recherche du nom dans l'onglet spécialité
                    Set re = Range(wst.Range("B3"), wst.Cells(3, dc)).Find(ws.Cells(3, j), lookat:=xlWhole, LookIn:=xlValues)