Erreur dans macro sous-totaux

flocolombia · 10 Décembre 2014

Bonjour à tous,

J'ai une macro qui fonctionne depuis que je l'ai créée (il y 8 mois) et voici qu'elle ne fonctionne plus...
Je ne sais pas d'où cela vient et j'avais vraiment galéré à la faire, je ne sais pas d'où vient l'erreur.
Ce code me permettait de mettre une ligne "Sous total nomduclient" en faisant un regroupement des clients en prenant la partie avant le "/" de leur nom. Par exemple je peux avoir des clients avec les nom :
client1
client1/ab
client1 /bc
client1
et je fais un sous-total (des montants associés) pour "client1"
Le problème est que depuis aujourd'hui, la macro fait le sous-total seulement pour le dernier client de mon tableau et supprime tous les autres.

Voici le code :

Sub CommandButton1_Click()
Dim i&, j&, X&
Dim D As Object, DTmp As Object, DCode As Object
Dim TReport As Variant, TTmp As Variant, TData As Variant
Dim Code$, Plg As Range

Set D = CreateObject("Scripting.dictionary")
Set DTmp = CreateObject("Scripting.dictionary")
Set DCode = CreateObject("Scripting.dictionary")
ReDim TReport(0)

With Sheets("Feuil1")
Set Plg = .Range(.Cells(2, 1), .Cells(Rows.Count, 5).End(3))
End With

TData = Plg
For i = LBound(TData, 1) To UBound(TData, 1)
If InStr(TData(i, 1), "Sous Total ") = 0 Then
Code = Split(TData(i, 4), "/")(0)
If Not DCode.Exists(Code) Then
ReDim Preserve TReport(1 To UBound(TReport) + 1)
ReDim TTmp(2)
Set TTmp(1) = CreateObject("Scripting.dictionary")
TTmp(2) = Code
TReport(UBound(TReport)) = TTmp
DCode(Code) = UBound(TReport)
End If
Set DTmp = TReport(DCode(Code))(1)
X = DTmp.Count
ReDim TTmp(1 To UBound(TData, 2))
For j = LBound(TData, 2) To UBound(TData, 2)
TTmp(j) = CStr(TData(i, j))
Next j
TReport(DCode(Code))(0) = TReport(DCode(Code))(0) + TData(i, 5)
DTmp(X) = TTmp
Set TReport(DCode(Code))(1) = DTmp
End If
Next i
Application.ScreenUpdating = False
Plg.ClearContents
With Sheets("Feuil1")
For i = LBound(TReport) To UBound(TReport)
Set DTmp = TReport(i)(1)
.Cells(.Rows.Count, 1).End(3)(2).Resize(DTmp.Count, 5).FormulaLocal = Application.Index(DTmp.Items, , 0)
With .Cells(.Rows.Count, 1).End(3)(2)
.Value = "Sous Total " & TReport(i)(2)
.Offset(, 4) = TReport(i)(0)
End With
Next i
End With
End Sub

Merci à toute personne pouvant m'aider!

Staple1600 · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Re

Paf
Même en lançant la macro dans un module sans passer par un bouton, cela ne fonctionne pas avec Excel 2013
(et cela également avec le fichier d'Efgé issu du premier fil)
A priori le problème de l'update concerne les ActiveX, pas les objets Dictionary ou les Arrays
Avec 2003, qu'obtiens-tu avec MsgBox UBound(TReport) ?

Efgé · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Bonsoir à tous 🙂

Pour paraphraser Luis Rego :
"De quoi de qu'est ce qu'on accuse t on mon code" 😀

Sérieusement, en collant les nouvelles données sur le premier fichier proposé, je ne vois pas de soucis.

Cordialement

Staple1600 · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Bonsoir Efgé

Y cause que sur Excel 2013 quand y clique sur le bouton, y zieute c't affaire, là, euh 😉

(et c'est pareil avec les fichiers exemples issus des deux fils cités)
et chez moi UBound(TReport) = 0
C'est pas normal, non ?

Efgé · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Re
Salut J.M
Il est vrai que je ne retrouve pas toujours le même résultat après passage du code !!??

Mais je regarderai demain, ici la malédiction M.S a frappée.
C'est vrai que c'est étrange quand même.

Cordialement

Staple1600 · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Re

Efgé
Sauf erreur de ma part
MsgBox UBound(TReport) ne devrait pas renvoyer 0, non ?

NB: Le résultat est le même si on lance la macro à partir d'un module et sans passer par un click sur le CommandButton.
Or la malédiction ne concerne a priori que les ActiveX.

Paf · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Re

Sous 2003 UBound(TReport) = 5

avec le classeur de ce fil

Paf · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Re,

en modifiant Code = Split(TData(i, 4), "/")(0) en Code = Trim(Split(TData(i, 4), "/")(0)) UBound(TReport) = 3.

normal puisque l'espace étant supprimé on n'a bien que 3 entreprises.

Staple1600 · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Re

Chez moi, j'ai toujours 0 avec MsgBox Ubound(TReport)
???
(même en faisant ta modif Paf)

Si... · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

salut

et 1si ... ? (pour le fun : autre macro avec TRIM pour gérer les espaces et autre disposition de réponse)

Staple1600 · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Bonsoir

Si...
Avec ta macro, il se passe quelque chose en G2 😉
(Donc OK avec Excel 2013 avec ton code)
Et nous avons les mêmes résultats (toi avec macro, moi sans 😉 )

Mais j'ai beau cherché je ne vois pas ce qui coince dans le code d'Efgé avec Excel 2013 ??

klin89 · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Bonsoir à tous,🙂

Une autre façon de procéder :
Sous Excel2003, résultat en feuil2

VB:

Option Explicit
Sub Sous_Totaux()
Dim dico As Object, i As Long, e, n As Long, txt As String
    Application.ScreenUpdating = False
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Feuil1")
        With .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 5)
            For i = 2 To .Rows.Count
                txt = Trim(Split(Trim(.Cells(i, 4)), "/", 2)(0))
                If Not dico.exists(txt) Then
                    Set dico(txt) = .Rows(1)
                End If
                Set dico(txt) = _
                Union(dico(txt), .Rows(i))
            Next
        End With
    End With
    With Sheets("Feuil2")
        .Cells.Clear
        For Each e In dico
            n = n + 1
            dico(e).Copy .Cells(n, 1)
            With .Cells(n, 1).CurrentRegion
                .Rows(1).Interior.ColorIndex = 43
                .Rows(1).BorderAround ColorIndex:=1, Weight:=xlThin
                With .Offset(.Rows.Count).Resize(1)
                    dico(e).Rows(1).Copy .Cells(1)
                    With .Columns("A:E")
                        .Clear
                        .Interior.ColorIndex = 19
                        .BorderAround ColorIndex:=1, Weight:=xlThin
                        .Value = _
                        Array("", "TOTAL", "=counta(r" & n + 1 & "c:r[-1]c)", e, "=sum(r" & n + 1 & "c:r[-1]c)")
                    End With
                End With
                With .Resize(.Rows.Count + 1)
                    .Font.Name = "calibri"
                    .VerticalAlignment = xlCenter
                    .BorderAround ColorIndex:=1, Weight:=xlThin
                    .Borders(xlInsideVertical).Weight = xlThin
                    .Columns("A:C").HorizontalAlignment = xlCenter
                End With
                n = n + .Rows.Count + 1
            End With
        Next
        .Cells.EntireColumn.AutoFit
        .Activate
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

Edit : je ne suis pas sûr de moi sur cette expression, si vous pouvez tester tous les cas.

Code:

txt = Trim(Split(Trim(.Cells(i, 4)), "/", 2)(0))

klin89

Staple1600 · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Bonsoir à tous

Klin89
ton code fonctionne sur Excel 2013

Sinon, j'ai toujours du mal à comprendre pourquoi cette réticence pour l'emploi de Données/Sous-total
(suggestion faite au message #5 du fil par mes soins et dans le fil initial par Chris)
Si vraiment, il faut du VBA, la macro tient alors en peu de ligne

Code:

Sub DonneesSTotalparMacro()
Columns("D:D").Insert Shift:=xlToRight
Range("D1") = "CLIENTS"
Range("D2:D10").Formula = "=TRIM(IF(ISERR(SEARCH(""/"",RC[1])),RC[1],MID(RC[1],1,SEARCH(""/"",RC[1])-1)))"
Range("A1:F10").Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(6), _
        Replace:=True, PageBreaks:=True, SummaryBelowData:=True
    
End Sub

Et pour l’esthétisme, on pourrait masquer la colonne D et étoffer un chouia la macro pour le fignolage

flocolombia · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Bonsoir,

Merci beaucoup à tous pour votre aide.
J'ai pris le temps de tester les solutions de chacun, elles sont toutes bonnes, mais mon problème étant d'avoir au final un résultat le plus proche possible de celui d'avant (afin de ne pas avoir a trop modifier toutes mes autres macros sur le fichier), la dernière macro de Staple1600 est la plus adaptée.
Je peux arriver tout seul au même résultat qu'auparavant, il y a seulement deux points sur lesquels j'ai du mal :
- comment faire pour appliquer ces sous-totaux pour tous les clients jusqu'à la dernière ligne non vide (c'est un fichier mis à jour régulièrement donc le nombre de clients évoluent constamment) ?
- comment recopier automatiquement toutes les cellules "Total" de la colonne D sur la colonne A (afin de pouvoir supprimer cette colonne D) jusqu'à la dernière non vide également ?

Un grand merci à tous encore une fois.

flocolombia · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

A noter que j'ai essayé avec ce type de code :
Dim DernLigne As Long
DernLigne = Range("A1048576").End(xlUp).Row

mais je dois mal l'utiliser parce que j'ai une erreur à chaque fois...

Staple1600 · 14 Décembre 2014

Re : Erreur dans macro sous-totaux

Bonsoir à tous

EDITION: je viens de voir que tu avais tester le End(xlUp).Row de ton propre chef.
Au moins je m'endors en sachant que tu as versé dans le mieux et que la curiosité t'habite, c'est donc mieux que bien 😉
Mais je reste taquin quand même car je dors mieux avec la mine réjouie. 😉
(Et puis j'ai pas mis toutes ces icônes et ces couleurs et mise en forme pour tout effacer maintenant 😉)

flocolombia
[taquinerie du dimanche soir avant d'enfiler mon pyjama]
Copier/Coller du code VBA, c'est bien
Le lire, le décortiquer pour le comprendre, c'est mieux 😉
Car ...

VB:

Sub DonneesSTotalparMacroII()
Dim Derlig&
Derlig = Cells(Rows.Count, "A").End(xlUp).Row ' hum cela me rappelle quelque chose ;)
Columns("D:D").Insert Shift:=xlToRight
Range("D1") = "CLIENTS"
Range("D2:D" & Derlig).Formula = "=TRIM(IF(ISERR(SEARCH(""/"",RC[1])),RC[1],MID(RC[1],1,SEARCH(""/"",RC[1])-1)))"
Range("A1:F" & Derlig).Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(6), _
        Replace:=True, PageBreaks:=True, SummaryBelowData:=True
End Sub

Et dans ton premier code, on avait

With Sheets("Feuil1")
Set Plg = .Range(.Cells(2, 1), .Cells(Rows.Count, 5).End(3))
End With

Cela permettait de déduire le dernier code que je viens de poster, non ? 😉

Au fait qui a écrit cela ? 😉

flocolombia à dit:
Re,
Merci pour la réponse, malheureusement je ne peux pas utilisé seulement la fonction sous-totaux d'excel.

[/pyjama enfilé, sous la couette, je glisse. Bonne nuit à tous]

Effectuez une recherche sur Excel Downloads...

Erreur dans macro sous-totaux

flocolombia

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

Pièces jointes

Staple1600

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Si...

XLDnaute Barbatruc

Pièces jointes

Staple1600

XLDnaute Barbatruc

klin89

XLDnaute Accro

Pièces jointes

Staple1600

XLDnaute Barbatruc

flocolombia

XLDnaute Nouveau

flocolombia

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée