Discussion :

[anna789]

Bonjour Dom,

Tu es un contributeur actif et de qualité, c'est indéniable. Je l'avais remarqué effectivement en regardant l'historique des tes interventions. Je t'ai juste indiqué mon sentiment suite à notre échange...

Voici mon code de débutante (toujours en attente de décrypter le tien, mais je suis bousculé cette semaine) :


Il me manque une seule chose c'est de pouvoir repasser sur un modèle anglo-saxon sur la dernière colonne en bout de course (remplacer les "," par ".") mais bon ce n'est pas grand chose ...

Bonne journée

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Option Explicit
 
Sub W()
 
' Filtre élaborée et somme.si.ens sous 4 critères
 
' Je supprime les points du modèle de chiffrage anglo-saxon
 
    Cells.Replace What:=".", Replacement:=".", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=False
 
' J'établis par filtre avancé une sélection des 4 premières colonnes sans doublon et récupère selon ces critères les informations associées au 3 dernières colonnes
 
    Range("A1:D1").Select
    Selection.Copy
    Range("N1").Select
    ActiveSheet.Paste
    Range("A2").Select
    Application.CutCopyMode = False
    Range("A:D").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "N:Q"), Unique:=True
    Range("E1:G1").Select
    Selection.Copy
    Range("R1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A:G").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "N:Q"), CopyToRange:=Range("N1:T1"), Unique:=True
 
'J'applique la fonction somme.si.ens sur critères des 4 premières colonnes pour cumul des données (H:J)
 
    Range("H1:J1").Select
    Selection.Copy
    Range("U1").Select
    ActiveSheet.Paste
    Range("U2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=+SUMIFS(C8,C1,RC[-7]&"""",C2,RC[-6]&"""",C3,RC[-5]&"""",C4,RC[-4]&"""")"
    Range("U2").Select
    Range("U2").AutoFill Destination:=Range("U2:U" & Range("S65536").End(xlUp).Row)
    Range("U2").Select
    Selection.Copy
    Range("V2").Select
   ActiveSheet.Paste
    Range("V2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=+SUMIFS(C8,C1,RC[-8]&"""",C2,RC[-7]&"""",C3,RC[-6]&"""",C4,RC[-4]&"""")"
    Range("V2").Select
    ActiveCell.FormulaR1C1 = _
        "=+SUMIFS(C9,C1,RC[-8]&"""",C2,RC[-7]&"""",C3,RC[-6]&"""",C4,RC[-5]&"""")"
    Range("V2").Select
    Range("V2").AutoFill Destination:=Range("V2:V" & Range("S65536").End(xlUp).Row)
    Range("V2").Select
    ActiveWindow.ScrollColumn = 11
    Selection.AutoFill Destination:=Range("V2:W2"), Type:=xlFillDefault
    Range("V2:W2").Select
    Range("W2").Select
    ActiveCell.FormulaR1C1 = _
        "=+SUMIFS(C10,C1,RC[-9]&"""",C2,RC[-8]&"""",C3,RC[-7]&"""",C4,RC[-6]&"""")"
    Range("W2").Select
    Range("W2").AutoFill Destination:=Range("W2:W" & Range("S65536").End(xlUp).Row)
    Range("W2").Select
 
' Je supprime les données initiales pour remplacement par les nouvelles
 
    Range("U2:W2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:M").Select
    Range("M1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    End Sub

[RyuAutodidacte]

Hi,
A casefayere

re
à Ryu
Merci mais j'imagine qu'il y a certainement d'autres moyen, perso je fais avec ce qui m'inspire sur le moment
Bonne journée

Ton idée m'a inspiré aussi puisque comme je l'ai dit c'est une très bonne idée
après avoir fait chauffé mes neurones voilà le résultat :
PS : Marc, j'espère ne pas avoir trop écorché ton code, si il y a une meilleurs façon de l'écrire (ce que je ne doute pas) corrige moi stp ,merci

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
Sub test_testOK()
Dim cLig As New Collection, c As Byte, L&, R&, VA, VR, X
    With Feuil4
        VA = .UsedRange.Value
        ReDim VR(1 To UBound(VA) - 1, 1 To 10)
        ReDim X(1 To UBound(VA) - 1) 'Tableau des critères pour addition
    For R& = 2 To UBound(VA)
            X(R - 1) = VA(R, 2) & "|" & VA(R, 3) & "|" & VA(R, 4) 'Enregistrement des critères dans le tableau X
            On Error Resume Next
            L = cLig(X(R - 1))
            On Error GoTo 0
        If L Then
            VR(L, 7) = VR(L, 7) + VA(R, 7) 'Addition en col 7
            VR(L, 8) = VR(L, 8) + VA(R, 8) 'Addition en col 8
            VR(L, 9) = VR(L, 9) + VA(R, 9) 'Addition en col 9
        Else
            L = cLig.Count + 1
            cLig.Add L, X(R - 1)
            For c = 1 To 10:  VR(L, c) = VA(R, c):  Next
        End If
                L = 0
    Next
        If cLig.Count < UBound(VR) Then
            .Range("A2:J2").Resize(cLig.Count).Value = VR 'Copie du tableau épuré des doublons additon faite
            .Rows(cLig.Count + 2 & ":" & UBound(VA)).Delete 'Effacement des lignes en supp
        End If
    End With
Set cLig = Nothing
End Sub

Bon je vais me remettre sur les Filter
Bonne journée

[Marc-L]

Bonjour Ryu,

cela m'a l'air vraiment bien mais j'ai décroché de cette discussion au post #16 …

_________________________________________________________________________________________________________

Je suis Paris, Charlie, Bruxelles, …

[RyuAutodidacte]

Re Marc,
j'ai juste posté sur le sujet et les personnes concernés (@casefayere et toi)
j'aurais pu faire autrement, mais bon si d'autres gens du forum cherche une solution, je la partage et ça profite à tous

En tout cas c'est cool si ça te semble vraiment bien (grâce à vous deux )