Macro générant des formules

Version imprimable

Voir 40 message(s) de cette discussion en une page

1 pièce(s) jointe(s)

Re à vous 2

@Sogeic,
Ta solution fonctionne parfaitement, j'ai repris le code et joué la simplicité. J'ai crée 3 macros différentes (calcul des comptes 6 et 7, et une autre pour calculer des totaux spécifiques) et je lance tout dans une seule pour arriver au résultat souhaité. Par contre le seul hic est que j'aurai aimé que les formules s'affichent (Somme(X;X)), et non en valeur. Ça m'évite d'actualiser la macro, tu me diras je peux modifier la macro pour qu'elle se lance automatiquement à chaque fois qu'une cellule est modifiée (en retirant la boucle sur tous les fichiers *xls)
Je t'avoue que j'ai repris bêtement le code... J'ai essayé de la comprendre mais je me suis rapidement perdu... C'est d'un tout autre niveau pour mes connaissances. (respect)

@RyuAutodidacte
MODIF : J'avais la conversation ouverte depuis ce matin, et je viens seulement de voir ta réponse, merci pour les explications! (désolé)

J'ai un peu mieux compris le fonctionnement de ta macro, pas bête les repères sur la mise en forme, il fallait y penser.
J'ai également crée une autre petite macro arriver à mes fins.
C'est quasi parfait! J'ai juste un petit soucis que je n'avais pas prévu, et que je n'arrive pas à régler.

Pièce jointe 403503

Comme l'exemple ci-dessus, les sous catégories s'affichent quelque soit le résultat (Ici aucun compte concerné donc 0). La macro me calcule tout de même une somme. Elle prend systématiquement la ligne "sous catégorie" + "la ligne du dessous". Et j'obtiens des jolies références circulaires :)
Faut-il rajouter une condition SI : SI il n'y a pas de n°compte en dessous d'une sous catégorie alors 0 ?
Ou faut-il modifier un paramètre dans le code actuel ?

En bidouillant un peu je n'ai pas réussit à modifier le code pour que cela fonctionne. Peux-tu m'éclairer ?

Et deuxième chose : je ne comprends pas le :

Code:

If Cells(i, 2).Interior.Color <> RGB(255, 255, 255) Then

La couleur de remplissage utilisée comme exemple à le code : "255, 255, 204". Pourquoi cela fonctionne t-il avec le code "255, 255, 255" ? Ou alors je n'ai rien compris

Voici mon code actuel :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 Sub CALCUL_DES_FORMULES() Dim AllGpe, Grp, DL&, DF_G As Boolean, VA, i&, ColGroupe As New Collection, Col_G, Vgpe, NomGpe$, Groupe$, Som$, SomTotal$ CHARGES = Array("CHARGES - GROUPE", "TOTAL CHARGES - GROUPE", "CHARGES - TA", "TOTAL CHARGES - TA") CHARGES_TA = Array("CHARGES - TA", "TOTAL CHARGES - TA") PRODUITS = Array("RA - GROUPE", "TOTAL RA - GROUPE", "RA - TA", "TOTAL RA - TA") PRODUITS_TA = Array("RA - TA", "TOTAL RA - TA") PRODUITS_TARIFICATION = Array("PRODUITS DE TARIFICATION", "TOTAL - PRODUITS DE TARIFICATION") CHARGES_EXCEP = Array("CHARGES EXCEPTIONNELLES", "TOTAL - CHARGES EXCEPTIONNELLES") PRODUITS_EXCEP = Array("PRODUITS EXCEPTIONNELS", "TOTAL - PRODUITS EXCEPTIONNELS") AllGpe = Array(CHARGES, PRODUITS, CHARGES_TA, PRODUITS_TA, PRODUITS_TARIFICATION, CHARGES_EXCEP, PRODUITS_EXCEP) DL = Cells(Rows.Count, "B").End(xlUp).Row: DF_G = False With ActiveSheet.Range(Cells(1), Cells(DL, "M")) For Each AG In AllGpe VA = .Columns.Item(2).Value For i = 16 To UBound(VA) If VA(i, 1) > "" Then If VA(i, 1) Like AG(Abs(DF_G)) & "*" Then If DF_G = False Then NomGpe = VA(i, 1) ColGroupe.Add VA(i, 1), NomGpe DF_G = True Else: DF_G = False Groupe = ColGroupe(NomGpe) & " _ " & .Cells(i, 12).Address ColGroupe.Remove NomGpe: ColGroupe.Add Groupe, NomGpe End If ElseIf DF_G = True Then If Cells(i, 2).Interior.Color <> RGB(255, 255, 255) Then Groupe = ColGroupe(NomGpe) & " _ " & .Cells(i, 12).Address ColGroupe.Remove NomGpe: ColGroupe.Add Groupe, NomGpe End If End If End If Next Application.ScreenUpdating = False For Each Col_G In ColGroupe Vgpe = Split(Col_G, " _ ") For i = 1 To UBound(Vgpe) - 1 .Range(Vgpe(i)).FormulaLocal = "=Somme(" & .Range(Vgpe(i)).Offset(1).Address & ":" & .Range(Vgpe(i + 1)).Offset(-1).Address & ")" Som = Som & "+" & Vgpe(i) Next .Range(Vgpe(UBound(Vgpe))).FormulaLocal = "=" & Mid(Som, 2) SomTotal = SomTotal & "+" & Vgpe(UBound(Vgpe)) Som = "" Next .Cells(DL, 12).FormulaLocal = "=" & Mid(SomTotal, 2) Application.ScreenUpdating = True Set ColGroupe = Nothing Next End With Call CALCUL_RESULTAT End Sub
Par contre ce code ne fonctionnera plus sur le fichier que j'avais envoyé car j'ai modifié les intitulés sur l'extraction par soucis de cohérence avec la macro, comme tu l'avais indiqué (j'avais des doublons sur les groupes : GROUPE 1 (charges) et GROUPE 1 (Produits) donc la macro ne pouvait fonctionner).

Un grand merci à vous deux pour votre aide

Bien cdt,

13/08/2018, 16h30
RyuAutodidacte
Re,

Peux tu m'envoyer un xlsx comme exemple avec l'ensemble et ce cas particulier tel que tu peux avoir tes fichiers dans la réalité - avec fausses données bien sur ("j'ai juste un petit soucis que je n'avais pas prévu, et que je n'arrive pas à régler. ")
En fait il n'y a pas de somme à calculer avec les lignes 178 et 179 (2 sous catégories)
j'ai m'a petite idée …

pour cette partie de code :

Code:

If Cells(i, 2).Interior.Color <> RGB(255, 255, 255) Then

cela veut dire si la cellule est différente de la couleur blanche, alors considère là comme sous catégorie - comme cela pas besoin de connaitre la couleur précise

Edit : peux tu y mettre une feuille résultat aussi stp

Edit 2 : pour cette partie là - Modifications fautes de frappes dans le code que j'ai ajouté comme exemple

Code:

CHARGES = Array("CHARGES - GROUPE", "TOTAL CHARGES - GROUPE", "CHARGES - TA", "TOTAL CHARGES - TA")

le code est fait pour marcher avec un début et une fin via True et False -or ici on se retrouve avec 4 valeurs texte au lieu de 2
Code:

1 2 CHARGES_1 = Array("CHARGES - GROUPE", "TOTAL CHARGES - GROUPE") CHARGES_2 = Array("CHARGES - TA", "TOTAL CHARGES - TA")
13/08/2018, 17h06
Julien_59

1 pièce(s) jointe(s)

Tu trouveras ci-joint mon fichier de travail

Tu as un onglet résultat ou je test une version opérationnelle de mon extraction.

Je continue de travailler dessus ce soir ou demain matin (même en cette période il faut traiter des urgences zZzZZzZZ)

Merci pour ton aide,

je reviens au plus vite vers toi concernant ton dernier message

Bien cdt,

Bonjour,

Nouveau code - j'ai changé le sytème de sélection des groupes en début et fin + correction du problème ("Et j'obtiens des jolies références circulaires":)) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub FormulaSum()
Dim AllGpe$, Grp$, DL&, DF_G As Boolean, VA, i&, ColGroupe As New Collection, Col_G, Vgpe, NomGpe$, Groupe$, Som$, SomTotal$
 
    AllGpe = "CHARGES - GROUPE | TOTAL CHARGES - GROUPE" & " | " & _
        "CHARGES - TA | TOTAL CHARGES - TA" & " | " & _
        "RA - GROUPE | TOTAL RA - GROUPE" & " | " & _
        "RA - TA | TOTAL RA - TA" & " | " & _
        "PRODUITS DE TARIFICATION | TOTAL - PRODUITS DE TARIFICATION" & " | " & _
        "CHARGES EXCEPTIONNELLES | TOTAL - CHARGES EXCEPTIONNELLES" & " | " & _
        "PRODUITS EXCEPTIONNELS | TOTAL - PRODUITS EXCEPTIONNELS"
 
    DL = Cells(Rows.Count, "B").End(xlUp).Row:      DF_G = False
    With ActiveSheet.Range(Cells(1), Cells(DL, "M"))
        VA = .Columns.Item(2).Value
        For i = 16 To UBound(VA)
                If VA(i, 1) > "" Then
                    If IsNumeric(Right(VA(i, 1), 1)) Then Grp = Mid(VA(i, 1), 1, Len(VA(i, 1)) - 2) Else Grp = VA(i, 1)
                    If AllGpe Like "*" & Grp & "*" Then
                        If DF_G = False Then
                            NomGpe = VA(i, 1)
                            ColGroupe.Add VA(i, 1), NomGpe
                            DF_G = True
                        Else: DF_G = False
                            Groupe = ColGroupe(NomGpe) & " _ " & .Cells(i, 12).Address
                            ColGroupe.Remove NomGpe:    ColGroupe.Add Groupe, NomGpe
                        End If
                    ElseIf DF_G = True Then
                        If Cells(i, 2).Interior.Color <> RGB(255, 255, 255) Then
                            Groupe = ColGroupe(NomGpe) & " _ " & .Cells(i, 12).Address
                            ColGroupe.Remove NomGpe:    ColGroupe.Add Groupe, NomGpe
                        End If
                    End If
                End If
            Next
            Application.ScreenUpdating = False
                For Each Col_G In ColGroupe
                    Vgpe = Split(Col_G, " _ ")
                    For i = 1 To UBound(Vgpe) - 1
                        If Evaluate(Vgpe(i)).Offset(1) <> Evaluate(Vgpe(i + 1)) Then
                            .Range(Vgpe(i)).FormulaLocal = "=Somme(" & .Range(Vgpe(i)).Offset(1).Address & ":" & .Range(Vgpe(i + 1)).Offset(-1).Address & ")"
                            Som = Som & "+" & Vgpe(i)
                        Else
                            .Range(Vgpe(i)).Value = 0
                        End If
                    Next
                        .Range(Vgpe(UBound(Vgpe))).FormulaLocal = "=" & Mid(Som, 2)
                        SomTotal = SomTotal & "+" & Vgpe(UBound(Vgpe))
                        Som = ""
                Next
                '.Cells(DL, 12).FormulaLocal = "=" & Mid(SomTotal, 2) ' tombe sur la dernière ligne - somme total des groupes - à mettre si nécessaire
            Application.ScreenUpdating = True
            Set ColGroupe = Nothing
            End With
End Sub

Edit : les explications des changements :
• j'ai mis les groupes dans une variable texte (texte en une ligne, mais codé sur plusieurs lignes pour la lisibilité).
Concernant les groupes contenant un chiffre, style "CHARGES - GROUPE 1" (ou 2 ou 3), etc, j'ai omis les chiffres afin de diviser le type de groupe identique (1 au lieu de 3),
et j'ai remplacer avec une vérification en amont (dans un if) si il y avait une donnée numérique à la fin du nom du groupe afin de le remodeler (Grp) pour la vérification dans un Like si nécessaire
Comme cela on check tous les groupes voulus et on évite la boucle supplémentaire …
• Pour éviter les références circulaires, dans la collection ColGroupe je vérifie si l'adresse en i décalage de 1 et identique à l'adresse en i + 1 dans la variable tableau créée sur chaque élément de la collection lors de la boucle

Code:

If Evaluate(Vgpe(i)).Offset(1) <> Evaluate(Vgpe(i + 1)) Then

Bonjour
Voici une solution avec des formules pour que la maj automatique se fasse
j'ai simplifié et commenté
le code VBA est assez simple ce qui est compliqué c'est de faire selon la structure du tableau

J'ai mis les résultats en colonne "N" pour les tests
- copier en valeur la colonne L dans N
- lancer
- verifier
- si OK remplacer dans le code colonne N par L et
tabVal(i, 1) Like "*N° COMPTE*" par : (tabVal(i, 1) Like "6*" or tabVal(i, 1) Like "7*")

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub calculSom(wb As Workbook)
    'Donnees de la feuille
    Dim nbLg As Long
    Dim tabVal As Variant
    Dim lgCat As Long, FormulaTot As String
 
    'Variables de boucle
    Dim i As Long
 
    With ThisWorkbook.Sheets(1)
 
        'Donnees de la feuille
        nbLg = .Cells(Application.Rows.Count, 2).End(xlUp).Row
        tabVal = .Range("B1:B" & nbLg).Value
 
        'Init des Totaux
        lgCat = 17
        FormulaTot = "="
 
        'Boucle sur les lignes
        For i = 17 To nbLg
 
            'B vide : fin
            If tabVal(i, 1) = "" Then Exit For
 
            'Total general
            If tabVal(i, 1) Like "*TOTAL*" Then
                .Range("N" & i).FormulaR1C1 = FormulaTot & "+R" & lgCat & "C"
                FormulaTot = "="
                '---
                .Range("N" & lgCat).FormulaR1C1 = "=SUM(R" & lgCat + 1 & "C:R" & i - 1 & "C)" ' R3C:R5C ligne 3 a 5 de la meme colonne
               '***Astuce
               'Passer la ligne GROUPE et reinitialiser les debuts des cat
               i = i + 2
               lgCat = i
               '***
 
            'Categorie : somme au dessus des groupes
            ElseIf Not tabVal(i, 1) Like "*N° COMPTE*" Then
                If i > 17 Then 'totaux des cat?gories au dessus des groupes
                    .Range("N" & lgCat).FormulaR1C1 = "=SUM(R" & lgCat + 1 & "C:R" & i - 1 & "C)" ' R3C:R5C ligne 3 ? 5 de la m?me colonne
                    FormulaTot = FormulaTot & "+R" & lgCat & "C"
                    lgCat = i
                End If
            End If
 
        Next i
 
        'memoire
         Set tabVal = Nothing
 
    End With
 
End Sub

La partie "astuce" pour que ca marche

Code:

1
2
3
4
5
6
 
               '***
               'Passer la ligne GROUPE et reinitialiser les debuts des cat
               i = i + 2
               lgCat = i
               '***

Bonjour,

@RyuAutodidacte
Cela fonctionne parfaitement! Un grand merci Cela va me gagner un temps plus que conséquent.
Mais, il y a toujours un "mais", j'ai une dernière petite amélioration ou je nécessite de l'aide. En fait sur mon extraction, je ne peux pas mettre les catégories avec une couleur de remplissage (car la couleur de remplissage s'applique sur toutes les lignes faisant références à la catégorie).
Pas de soucis, je vais passer par une macro simple (qui se lancera en première). Mais je n'arrive pas à définir une "plage" de variable.

Mon code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub Mise_en_forme() Dim Categorie, NombreLigne As Integer NombreLigne = Cells(Rows.Count, 2).End(xlUp).Row Categorie = "Achats" For i = 1 To NombreLigne If Cells(i, 2) = Categorie Then Cells(i, 2).Select Cells(i, 2).Interior.Color = RGB(237, 237, 237) End If Next End Sub
Mon code fonctionne, dés qu'il trouve "Achats", il met la cellule avec la couleur de remplissage indiqué.
En fait je cherche à définir une plage de variable et de lui dire : Dès que tu trouves, "Achats" OU "xx" OU "yy" etc.. tu mets une couleur de remplissage

Et autre question, le code :

Code:

NombreLigne = Cells(Rows.Count, 2).End(xlUp).Row

Cela repère bien la dernière cellule non vide de la colonne B en partant du bas du classeur ou en partant du haut ? (j'ai un doute)

Merci pour ton aide,

@sogedic
Je test ça

(J'ai l'impression d'être un enfant, je m'amuse en découvrant vos codes :))

Merci à vous,

Bien cdt,

14/08/2018, 11h25
RyuAutodidacte

Re,

Citation:

En fait sur mon extraction, je ne peux pas mettre les catégories avec une couleur de remplissage (car la couleur de remplissage s'applique sur toutes les lignes faisant références à la catégorie).

Si les catégories sont en bold on peut modifier en conséquence cela marchera de la même façon. Est ce possible pour l'extraction ???

Edit :

Citation:

Cela repère bien la dernière cellule non vide de la colonne B en partant du bas du classeur ou en partant du haut ?

Rows.Count est le nombre total de ligne dans la feuille End(xlUp) on remonte, donc oui du haut vers le bas

Oui de base les catégories sortent en gras donc ce n'est pas un problème,

Par contre par curiosité je veux bien savoir comment je peux déterminer une variable composée de plusieurs éléments pour qu'il applique une seule et même action pour chacun des éléments trouvés.

Comme mon code ci-dessous qui ne fonctionne que pour "Achats"
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub Mise_en_forme() Dim Categorie, NombreLigne As Integer NombreLigne = Cells(Rows.Count, 2).End(xlUp).Row Categorie = "Achats" 'je voudrai en mettre plusieurs à cet endroit For i = 1 To NombreLigne If Cells(i, 2) = Categorie Then Cells(i, 2).Select Cells(i, 2).Interior.Color = RGB(237, 237, 237) End If Next End Sub
Merci pour ma culture :)

14/08/2018, 12h10
RyuAutodidacte
Citation:

Oui de base les catégories sortent en gras donc ce n'est pas un problème

Dans mon code remplacé la ligne pour les couleurs par celle de Font.Bold
Code:

1 2 'If Cells(i, 2).Interior.Color <> RGB(255, 255, 255) Then '<= ligne à remplacer If Cells(i, 2).Font.Bold = True Then ' <= par celle-ci
Corr. des déclarations des variables (Integer pas faut pour le nb de ligne mais vaut mieux utilisé Long si on dépasse 32 767 lignes)
Utiliser les variables en VBA Excel

Code:

Dim Categorie as string, NombreLigne As Long

On évite tout ce qui est Select, Selection pour appliquer le code en direct

Citation:

Par contre par curiosité je veux bien savoir comment je peux déterminer une variable composée de plusieurs éléments pour qu'il applique une seule et même action pour chacun des éléments trouvés.
Comme mon code ci-dessous qui ne fonctionne que pour "Achats"

tu as un exemple dans ma Macro avec Like
Code:

1 2 3 4 5 For i = 1 To NombreLigne If Cells(i, 2) Like "*" & Categorie & "*" Then Cells(i, 2).Interior.Color = RGB(237, 237, 237) End If Next
Voir ICI => Manipuler les chaînes de caractères en VB6 et VBA Excel
14/08/2018, 15h13
Julien_59

Super, merci à vous deux pour vos solutions,

Tout marche parfaitement bien, et j'ai réussit à lancer la macro sur tous mes fichiers.

Un énorme merci, j'ai bien appris en plus, ce fut très instructif !

Vous êtes au top!

Bien cdt
14/08/2018, 16h50
Julien_59

1 pièce(s) jointe(s)

En fait, petit soucis RyuAutodidacte

Je me permets de solliciter une dernière fois ton aide,

J'ai des incohérences quand je consolide, et quand je lance la macro fichier par fichier j'ai des soucis de calcul sur certaines sommes :

Mon fichier est en PJ, dans un même groupe la somme de certaines catégories se calcul et pour d'autres non. J'ai mis des petits "OK" et "PB" pour que ce soit plus visuel.

Je commence à creuser

-----

Modif du message,

Je remarque que quand je lance une deuxième fois la macro, certaines sommes se calculent (qui n'étaient pas calculées), et certaines ne se calculent plus (alors qu'elles l'étaient).
14/08/2018, 16h56
RyuAutodidacte

1 pièce(s) jointe(s)

Re,

OK je regarde le pourquoi du comment …

Edit : 1ère vérif ok - ce n'est pas dans la 1ère partie du code cela repère bien dans ColGroupe

Pièce jointe 403786

Suite de la vérif …

En effet de petit ajustement de code à faire sur la fin de celui-ci, afin de considérer les conditions des différents calculs/résultats pouvant arriver.
Dis moi si tout est ok de ton coté (normalement en repassant la macro cela corrigera automatiquement) :
PS : j'ai désactivé "SomTotal" qui à mon avis ne te sers pas (libre à toi de le réactiver si nécessaire)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub CALCUL_DES_FORMULES()
Dim AllGpe$, Grp$, DL&, DF_G As Boolean, VA, i&, ColGroupe As New Collection, Col_G, Vgpe, NomGpe$, Groupe$, Som$, SomTotal$
 
    AllGpe = "CHARGES - GROUPE | TOTAL CHARGES - GROUPE" & " | " & _
        "CHARGES - TA | TOTAL CHARGES - TA" & " | " & _
        "RA - GROUPE | TOTAL RA - GROUPE" & " | " & _
        "RA - TA | TOTAL RA - TA" & " | " & _
        "PRODUITS DE TARIFICATION | TOTAL - PRODUITS DE TARIFICATION" & " | " & _
        "CHARGES EXCEPTIONNELLES | TOTAL - CHARGES EXCEPTIONNELLES" & " | " & _
        "PRODUITS EXCEPTIONNELS | TOTAL - PRODUITS EXCEPTIONNELS"
 
    DL = Cells(Rows.Count, "B").End(xlUp).Row:      DF_G = False
    With ActiveSheet.Range(Cells(1), Cells(DL, "M"))
        VA = .Columns.Item(2).Value
        For i = 16 To UBound(VA)
                If VA(i, 1) > "" Then
                    If IsNumeric(Right(VA(i, 1), 1)) Then Grp = Mid(VA(i, 1), 1, Len(VA(i, 1)) - 2) Else Grp = VA(i, 1)
                    If AllGpe Like "*" & Grp & "*" Then
                        If DF_G = False Then
                            NomGpe = VA(i, 1)
                            ColGroupe.Add VA(i, 1), NomGpe
                            DF_G = True
                        Else: DF_G = False
                            Groupe = ColGroupe(NomGpe) & " _ " & .Cells(i, 12).Address
                            ColGroupe.Remove NomGpe:    ColGroupe.Add Groupe, NomGpe
                        End If
                    ElseIf DF_G = True Then
                        If Cells(i, 2).Font.Bold = True Then
                            Groupe = ColGroupe(NomGpe) & " _ " & .Cells(i, 12).Address
                            ColGroupe.Remove NomGpe:    ColGroupe.Add Groupe, NomGpe
                        End If
                    End If
                End If
            Next
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
                For Each Col_G In ColGroupe
                    Vgpe = Split(Col_G, " _ ")
                    For i = 1 To UBound(Vgpe) - 1
                        If .Range(Vgpe(i)).Offset(1).Address <> .Range(Vgpe(i + 1)).Address Then
                            .Range(Vgpe(i)).Formula = "=SUM(" & .Range(Vgpe(i)).Offset(1).Address & ":" & .Range(Vgpe(i + 1)).Offset(-1).Address & ")"
                            Som = Som & "+" & Vgpe(i)
                        Else
                            .Range(Vgpe(i)).Value = 0
                        End If
                    Next
                            With .Range(Vgpe(UBound(Vgpe)))
                                If "=" & Mid(Som, 2) <> "=" Then .Formula = "=" & Mid(Som, 2) Else .Value = 0
                            End With
                        'SomTotal = SomTotal & "+" & Vgpe(UBound(Vgpe))
                        Som = ""
                Next
                '.Cells(DL, 12).FormulaLocal = "=" & Mid(SomTotal, 2) ' tombe sur la dernière ligne - somme total des groupes à mettre si nécessaire
            Application.Calculation = xlCalculationAutomatic
            Application.ScreenUpdating = True
            Set ColGroupe = Nothing
            End With
End Sub

Edit : j'ai rajouté dans le code :

Code:

1
2
3
4
5
 ' … code
Application.Calculation = xlCalculationManual
 ' … code
Application.Calculation = xlCalculationAutomatic
 ' … code

Citation:

J'ai des incohérences quand je consolide, et quand je lance la macro fichier par fichier j'ai des soucis de calcul sur certaines sommes :

Bien vu, ne maitrisant pas tous les tenants et aboutissants des résultats du fichier, tes tests sont du grande utilité afin de chasser les petits défauts dans le code

16/08/2018, 08h58
Julien_59

Bonjour RyuAutodidacte

Cela fonctionne parfaitement ! Je creuse sur les modifications que tu as apportés et je me lance dans plusieurs tests (sur quelques fichiers un par un et sur un consolidé)

Je reviens vers toi, un grand merci,

Bien cdt

Est-ce que tu peux m'expliquer rapidement ce que tu as fait exactement pour que je comprenne ? J'ai quelques lacunes là:)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub CALCUL_DES_FORMULES_3()
 
Dim AllGpe$, Grp$, DL&, DF_G As Boolean, VA, i&, ColGroupe As New Collection, Col_G, Vgpe, NomGpe$, Groupe$, Som$, SomTotal$
 
    AllGpe = "CHARGES - GROUPE | TOTAL CHARGES - GROUPE" & " | " & _
        "CHARGES - TA | TOTAL CHARGES - TA" & " | " & _
        "RA - GROUPE | TOTAL RA - GROUPE" & " | " & _
        "RA - TA | TOTAL RA - TA" & " | " & _
        "PRODUITS DE TARIFICATION | TOTAL - PRODUITS DE TARIFICATION" & " | " & _
        "CHARGES EXCEPTIONNELLES | TOTAL - CHARGES EXCEPTIONNELLES" & " | " & _
        "PRODUITS EXCEPTIONNELS | TOTAL - PRODUITS EXCEPTIONNELS"
 
    DL = Cells(Rows.Count, "B").End(xlUp).Row:      DF_G = False
    With ActiveSheet.Range(Cells(1), Cells(DL, "M"))
        VA = .Columns.Item(2).Value
        For i = 16 To UBound(VA)
                If VA(i, 1) > "" Then
                    If IsNumeric(Right(VA(i, 1), 1)) Then Grp = Mid(VA(i, 1), 1, Len(VA(i, 1)) - 2) Else Grp = VA(i, 1)
                    If AllGpe Like "*" & Grp & "*" Then
                        If DF_G = False Then
                            NomGpe = VA(i, 1)
                            ColGroupe.Add VA(i, 1), NomGpe
                            DF_G = True
                        Else: DF_G = False
                            Groupe = ColGroupe(NomGpe) & " _ " & .Cells(i, 12).Address
                            ColGroupe.Remove NomGpe:    ColGroupe.Add Groupe, NomGpe
                        End If
                    ElseIf DF_G = True Then
                        If Cells(i, 2).Font.Bold = True Then
                            Groupe = ColGroupe(NomGpe) & " _ " & .Cells(i, 12).Address
                            ColGroupe.Remove NomGpe:    ColGroupe.Add Groupe, NomGpe
                        End If
                    End If
                End If
            Next
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
                For Each Col_G In ColGroupe
                    Vgpe = Split(Col_G, " _ ")
                    For i = 1 To UBound(Vgpe) - 1
                        'If Evaluate(Vgpe(i)).Offset(1) <> Evaluate(Vgpe(i + 1)) Then (ANCIEN CODE)
                        If .Range(Vgpe(i)).Offset(1).Address <> .Range(Vgpe(i + 1)).Address Then
                            '.Range(Vgpe(i)).FormulaLocal = "=Somme(" & .Range(Vgpe(i)).Offset(1).Address & ":" & .Range(Vgpe(i + 1)).Offset(-1).Address & ")" (ANCIEN CODE)
                            .Range(Vgpe(i)).Formula = "=SUM(" & .Range(Vgpe(i)).Offset(1).Address & ":" & .Range(Vgpe(i + 1)).Offset(-1).Address & ")"
                            Som = Som & "+" & Vgpe(i)
                        Else
                            .Range(Vgpe(i)).Value = 0
                        End If
                    Next
                        '.Range(Vgpe(UBound(Vgpe))).FormulaLocal = "=" & Mid(Som, 2) (ANCIEN CODE)
                            With .Range(Vgpe(UBound(Vgpe)))
                                If "=" & Mid(Som, 2) <> "=" Then .Formula = "=" & Mid(Som, 2) Else .Value = 0
                            End With
                        'SomTotal = SomTotal & "+" & Vgpe(UBound(Vgpe)) (ANCIEN CODE)
                        Som = ""
                Next
                '.Cells(DL, 12).FormulaLocal = "=" & Mid(SomTotal, 2) ' tombe sur la dernière ligne - somme total des groupes à mettre si nécessaire
            'Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
            Application.ScreenUpdating = True
            Set ColGroupe = Nothing
            End With
 
End Sub

J'ai mis l'ancien code avec des ' devant pour te repérer facilement, le nouveau code est juste en dessus à chaque fois.

Je vais faire des tests: )

Merci

1 pièce(s) jointe(s)

Bonjour,

Explication :

Code:

1
2
                        'If Evaluate(Vgpe(i)).Offset(1) <> Evaluate(Vgpe(i + 1)) Then (ANCIEN CODE)
                        If .Range(Vgpe(i)).Offset(1).Address <> .Range(Vgpe(i + 1)).Address Then

• Ici je me suis trompé car avec Evaluate j'obtenais la valeur de la cellule
alors que ce qui m'intéresse, c'est de comparer les adresses des cellules à Vgpe(i) décalage de 1 ligne avec Vgpe(i + 1) (l'adresse suivante enregistré dans la variable tableau)

Code:

1
2
                            '.Range(Vgpe(i)).FormulaLocal = "=Somme(" & .Range(Vgpe(i)).Offset(1).Address & ":" & .Range(Vgpe(i + 1)).Offset(-1).Address & ")" (ANCIEN CODE)
                            .Range(Vgpe(i)).Formula = "=SUM(" & .Range(Vgpe(i)).Offset(1).Address & ":" & .Range(Vgpe(i + 1)).Offset(-1).Address & ")"

• Ici j'ai juste mis la formule en anglais, ce qui permet de le faire marcher sur n'importe quel Excel quelque soit la version de celui-ci (En anglais, Allemand, … etc.)

Code:

1
2
3
4
                         '.Range(Vgpe(UBound(Vgpe))).FormulaLocal = "=" & Mid(Som, 2) (ANCIEN CODE)
                            With .Range(Vgpe(UBound(Vgpe)))
                                If "=" & Mid(Som, 2) <> "=" Then .Formula = "=" & Mid(Som, 2) Else .Value = 0
                            End With

• Ici j'ai rajouté un condition pour éviter que l'on se retrouve avec un simple "=" dans la cellule, ex. cas des catégories sans compte :

Pièce jointe 404079

Donc au lieu d'avoir "=" on met la valeur 0 directement
PS : une autre solution serait de le mettre en formule au lieu de mettre la valeur 0 (mais est ce souhaitable ???) - à vérifier qd même si tout est ok :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
                For Each Col_G In ColGroupe
                    Vgpe = Split(Col_G, " _ ")
                    For i = 1 To UBound(Vgpe) - 1
                        If .Range(Vgpe(i)).Offset(1).Address <> .Range(Vgpe(i + 1)).Address Then
                            .Range(Vgpe(i)).Formula = "=SUM(" & .Range(Vgpe(i)).Offset(1).Address & ":" & .Range(Vgpe(i + 1)).Offset(-1).Address & ")"
                            Som = Som & "+" & Vgpe(i)
                        Else
                            .Range(Vgpe(i)).Value = 0
                            Som = Som & "+" & Vgpe(i)
                        End If
                    Next
                                .Range(Vgpe(UBound(Vgpe))).Formula = "=" & Mid(Som, 2)
                        Som = ""
                Next

PS_2 : tout ce qui est "RESULTAT D'EXPLOITATION", "RESULTAT COMPTABLE", "RESULTAT ADMINISTRATIF" pourrait être calculé via la collection, mais ça c'est une autre histoire …

Un grand merci pour ces explications,
Et pas besoin de mettre une formule quand le résultat est "0", ni de mettre une formule pour les différents résultats (Comptable/exploitation/etc...). Pour les résultat je lance une seconde macro qui reprend les formules des autres colonnes, qui elles sont bonnes. *
J'ai testé avec la consolidation et cela marche parfaitement, je n'ai plus de soucis. Donc pour moi tout est ok !

Si je peux abuser et et demander un dernier conseil. Toutes mes extractions de l'ERP sont sous un format de compatibilité en .xls. Je souhaiterai toutes les convertir en .xlsm pour alléger les fichiers.

J'ai commencé une macro mais rien ne ce passe quand je la lance, je ne vois pas ce qui cloche
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub XLSM_save() Dim wb As Workbook Dim Fichier As String 'déclaration de la variable de type chaîne Application.DisplayAlerts = False Fichier = ActiveWorkbook.Name ' le nom du classeur actif est affecté à Fichier lefichier = Dir("CHEMIN*.xls") 'Tous les fichiers .xls du répertoire b = 1 While lefichier <> "" Workbooks.Open "CHEMIN\" & lefichier ' ouverture du fichier ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Name, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 'Enregistrement du fichier avec l'extension .xlsm (trouvé à partir de l'assitant macro) ActiveWorkbook.Close 'fermeture du fichier Application.Quit Application.DisplayAlerts = True Wend End Sub
Pour info, les extractions sont toutes dans un même répertoire, et le fichier sur lequel je vais lancer la MACRO est dans ce même répertoire

Merci pour cette dernière demande et je passe le sujet en résolu juste après :)

16/08/2018, 14h40
RyuAutodidacte

Re,

Citation:

Merci pour cette dernière demande et je passe le sujet en résolu juste après

Cela devrait faire l'objet d'une nouvelle discussion car ceci n'a rien a voir avec la demande de cette discussion, si qq un fait une recherche, il va se retrouver avec des sujets mélangés … ;)

si les fichiers ne sont pas destinés à avoir de macro alors autant utiliser le format xlsx

pour info :https://www.developpez.net/forums/d1...quoi-utiliser/
Faire une recherche avec : "excel fichier XLS ou XLSX"

Pour ma part si les fichiers de données n'ont pas besoin de macro (la macro peut être lancé d'un autre classeur fait pour cela), j'opterais pour le format xlsx

C'est toujours bien de repartir de zéro afin d'analysé chaque action du code (faire une action bien la comprendre et passer à la suivante)
une fois chaque actions passées au crible, les rassembler entre elles à l'endroit qu'il convient pour le bon déroulement du code :
- permettra d'ouvrir les fichier (via Workbooks.Open) : https://excel.developpez.com/faq/?pa...BoucleFichiers
- permettra de modifier le nom du fichier (enlever l'extension) afin de lui rajouter l'extension voulu pour un enregistrement par exemple : https://silkyroad.developpez.com/VBA...nesCaracteres/
- … Enregistrer-sous …
…

Voilà

PS : pour toutes interventions dans cette discussion d'un forumeur dont la réponse t'a été utile, tu peux, si tu le souhaites, mettre un :plusser: (se trouvant en bas à droite de chaque post)
16/08/2018, 14h47
Julien_59

Ok, je vais regarder tout ça :)

En tout cas un très grand merci pour le temps que tu as consacré à mon problème et pour la solution trouvée ! En plus j'ai appris pas mal de choses :)

De même pour sogedic !

Vous êtes vraiment au top, encore merci

Je passe le sujet en résolu.

Voir 40 message(s) de cette discussion en une page