RESOLU: Tri doublon totalisation

misteryann

XLDnaute Occasionnel
Bonjour à tous.
Voici mon nouveau problème... :)
On me demande les surfaces chauffées et non chauffées de différentes écoles (économie d'énergie obligent :) )
Aussi je souhaite adapter un code de M. Boisgontier à mon fichier.

Le principe:
1- un fichier par école (j'ai juste mis quelques bâtiments (à terme de 1 à xxx bâtiments)
2- dans la colonne "M" un tri SANS doublons
3- pas de formule si la ligne est vide (colonne N et O).
4- mise à jour à l'ouverture du fichier

J'espère que je suis assez explicite.

Cordialement.
 

Pièces jointes

  • Classeur1.xlsx
    110.7 KB · Affichages: 51
  • Copie de SupDoublonsTotalisation.xls
    57 KB · Affichages: 54
  • Classeur1.xlsx
    110.7 KB · Affichages: 57
Dernière édition:

CISCO

XLDnaute Barbatruc
Re : Tri doublon totalisation

Bonjour

Tu peux faire avec
Code:
=INDEX(D$1:D$6;MIN(SI(NB.SI(M$1:M1;D$2:D$6)=0;LIGNE($2:$6))))
en matriciel, donc à valider avec Ctrl+maj tempo+entrer.

Si tu as plus de 10 lignes dans le tableau de gauche décrivant les pièces de l'école, il te suffit de remplacer les 6 dans cette formule par le n° de la dernière ligne de ce tableau de gauche.

@ plus

P.S : Est-ce que tu travaillerais, par le plus grand des hasards, dans un syndicat mixte intercommunal, type SYDEN, SYDEEL... ?
 

misteryann

XLDnaute Occasionnel
Re : Tri doublon totalisation

Bonsoir CISCO.
Réponse au PS: non pas un syndicat intercommunal, mais un ministère...;):D

Ce que je souhaite vraiment, c'est adapter le classeur SupDoublonsTotalisation.xls‎ dans mon fichier.

Merci pour ton attention...

Cordialement.

Yann
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Tri doublon totalisation

bonsoir,

Code:
Sub Totalisation()
  For s = 1 To Sheets.Count
   Set f1 = Sheets(s)
   a = f1.Range("A2:G" & f1.[A65000].End(xlUp).Row)
   Set dc = CreateObject("Scripting.Dictionary")
   Set dnc = CreateObject("Scripting.Dictionary")
   For i = 1 To UBound(a)
     clé = Application.Trim(a(i, 4))
     If a(i, 7) = "C" Then dc(clé) = dc(clé) + a(i, 5): dnc(clé) = dnc(clé)
     If a(i, 7) = "NC" Then dnc(clé) = dnc(clé) + a(i, 5): dc(clé) = dc(clé)
   Next
   If dc.Count > 0 Then
     f1.[M2].Resize(dc.Count) = Application.Transpose(dc.keys)
     f1.[N2].Resize(dnc.Count) = Application.Transpose(dc.items)
     f1.[O2].Resize(dnc.Count) = Application.Transpose(dnc.items)
   End If
  Next s
End Sub

ou

Code:
Sub Totalisation2()
  For s = 1 To Sheets.Count
    Set f1 = Sheets(s)
    a = f1.Range("A2:G" & f1.[A65000].End(xlUp).Row)
    Dim c()
    ReDim c(1 To UBound(a, 1), 1 To 3)
    Maxligne = 0
    Set mondico = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
     clé = Application.Trim(a(i, 4))
     If Not mondico.exists(clé) Then
       Maxligne = Maxligne + 1:  mondico.Add clé, Maxligne: c(Maxligne, 1) = clé: lig = Maxligne
     Else
       lig = mondico.Item(clé)
     End If
     If a(i, 7) = "C" Then c(lig, 2) = c(lig, 2) + a(i, 5)
     If a(i, 7) = "NC" Then c(lig, 3) = c(lig, 3) + a(i, 5)
   Next
   f1.[M2].Resize(mondico.Count, UBound(c, 2)) = c
  Next s
End Sub

jb
 

Pièces jointes

  • Classeur1-1.xls
    408.5 KB · Affichages: 70
  • Classeur1-1.xls
    408.5 KB · Affichages: 58
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 786
Membres
101 817
dernier inscrit
carvajal