Discussion :

[Tykkle]

Bonjour,

Je suis assistant comptable et j'aimerais apporter quelques améliorations sur des tableaux de répartition de frais utilisés par mon entreprise.
Voilà le topo :

Il y a une bonne centaines de lignes téléphoniques auxquelles je dois rattacher la somme dûe pour le mois.
Par la suite les responsables d'affaires me donnent par mail des numéros ,selon l'employé concerné, sur lesquels je dois imputer des frais.

J'aimerais utiliser une macro qui me calculerais automatiquement les sous-totaux par numéro d'affaires
Mais le problème est qu'avec une fonction somme.si basique le sous total est calculé plusieurs fois par nombre d'affaires, et puis j'apprécie travailler avec des macros même si mon niveau est encore assez basique en VBA

Je joint un fichier exemple où j'ai masqué les noms, le calcul que j'aimerais effectuer par Macro se trouve dans la colonne G.

Merci d'avance pour toute aide apporté !

[had4789]

Bonjour,

Je te propose de faire cela:
1°) Tu fais une copie de ta feuille, car on est jamais trop prudent
2°) On fait un tri sur le numéro de numéro d'affaire
3°) Tu fais un IF. Tu dis que si le numéro de série est est identique au numéro de série du dessus alors tu fais la somme en G
4°) Tu supprimes les doublons

[Kimy_Ire]

Salut Tykkle,

Alors je ne sais pas si je vais accéder à ta requête exacte, mais moi j'aurais fait un truc du type :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Sub tykkle()
Dim i, j As Integer
Dim rng_ori As Range
Dim table()
Dim rd As Integer
Dim bool As Boolean
 
With Worksheets("Feuil1")
    Set rng_ori = .Range("F2")
    rd = 1
    ReDim table(1 To 2, 1 To rd)
    table(1, rd) = rng_ori
    table(2, rd) = rng_ori.Offset(0, -1)
    For i = 1 To .Columns(6).Find("*", , , , , xlPrevious).Row
        If rng_ori.Offset(i, 0) <> "" Then
            bool = True
            For j = LBound(table, 2) To UBound(table, 2)
                If rng_ori.Offset(i, 0) = table(1, j) Then
                    table(2, j) = table(2, j) + rng_ori.Offset(i, -1)
                    bool = False
                End If
            Next j
 
            If bool Then
                rd = rd + 1
                ReDim Preserve table(1 To 2, 1 To rd)
                table(1, rd) = rng_ori.Offset(i, 0)
                table(2, rd) = rng_ori.Offset(i, -1)
            End If
        End If
    Next i
End With
 
With Worksheets("Feuil2")
    .UsedRange.ClearContents
    .Range("A1") = "N° AFFAIRE"
    .Range("B1") = "Total par AFF"
 
    Set rng_ori = .Range("A1")
 
    For i = LBound(table, 2) To UBound(table, 2)
        rng_ori.Offset(i, 0) = table(1, i)
        rng_ori.Offset(i, 1) = table(2, i)
    Next i
End With
 
End Sub

Je te fais un résumé en "Feuil2" de tes numéros d'affaire et de leur totaux.
A savoir, peut-être qu'en passant par les filtres c'est plus pratique.

N'hésite pas revenir vers moi.

Cordialement,
Kimy

[had4789]

Bonjour,

Tykkle tu veux créer un programme pour la NASA???

Je pense que le code ci-dessous suffit largement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub t()
 
Dim i As Integer
'Tu fais une copie de la feuille 1 à la feuille 2
Sheets("Feuil1").Range("A1:S1").Copy Destination:=Sheets("Feuil2").Range("A1:S1")
 
 
 
Sheets("Feuil2").Select
 
              Range("A2:R3000").Sort key1:=Range("F2"), order1:=xlAscending
 
With ThisWorkbook.Sheets("Feuil1")
'Précisez le nom de votre feuille
            For i = .Range("F" & .Rows.count).End(xlUp).Row To 2 Step -1
'je travaille sur la colonne F
'Rows.count permet de retourner le nombre de ligne de la plage range
                        If .Range("F" & i).Value = .Range("F" & i - 1).Value Then
                        'Je dis que si la valeur de la cellule F et égale à la valeur de la celule précédente alors
 
                                    .Range("G" & i).Value = .Range("G" & i - 1).Value + .Range("E" & i).Value
                               'La valeur de la case G vaut la valeur de la cellule au dessous plus la valeur correspondant dans la colonne F
                               Else
 
                                 .Range("G" & i).Value = .Range("E" & i).Value
                                 'Si les valeurs sont différentes alros je revoins simplement la valeur de la colonne E
                        End If
            Next i
End With
 
End Sub

[78chris]

Bonjour

On peut simplement modifier la formule ainsi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(NB.SI($F$2:$F2;F2)=1;SOMME.SI($F$2:$F$21;F2;$E$2:$E$21);"")

Mais on est en 2014, tu as Excel 2010, les tableaux (au sens 2007-2013) et tableaux croisés dynamiques sont 1000 fois plus pratiques pour faire cela sans avoir besoin de tri, saut de lignes... avec en prime des segments pour focaliser, si besoin, sur un responsable ou une affaire...

[Kimy_Ire]

Mais on est en 2014, tu as Excel 2010, les tableaux (au sens 2007-2013) et tableaux croisés dynamiques sont 1000 fois plus pratiques pour faire cela sans avoir besoin de tri, saut de lignes... avec en prime des segments pour focaliser, si besoin, sur un responsable ou une affaire...

Héhé !

J'suis un peu bête de pas y avoir pensé !

C'est ça la solution ! ^^

Kimy