Discussion :

[mouncefdi]

Bonjour tout le monde,

Je me permets de vous solliciter encore une fois pour un coup de pouce.

J’ai des budgets dans ma colonne A et la liste des enterprises correspondantes dans ma colonne B.

Pour un même budget je peux avoir dans la cellule correpondante de la colonne B: 1 seule enterprise, plusieurs enterprises séparées par / ou aucune enterprise (une meme enterprise peut correspondre à plusieurs budget et donc elle peut se répéter dans ma colonne B)

Je souhaite faire une macro qui qui cherche pour chaque enterprise l’ensemble des budgets qui lui sont affectés et qui les somme pour chaque enterprise (car une enterprise peut paraitre a plusieurs reprises dans ma colonne B, exemple: B2: Vinci, B7: SFR/Vinci/Orange…).

Dans le cas ou il n y a pas d’entreprise correspondante au niveau de la colonne B alors ignorer.

En définitive, je souhaite établir un classement des enterprises pas budget.

N’hesiter pas à me sousmettre vos idées, merci beaucoup.

Je reste à votre disposition pour vous soumettre un échantillon de mon fichier.

Cordialement,

[mapeh]

Bonjour,

Essaie ce code :

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
Sub entrep()
Dim Cel As Range
Dim I As Byte
Dim LesEntreprises As Object
Dim Tmp
Set LesEntreprises = CreateObject("Scripting.Dictionary")
For Each Cel In Range("B2:B" & [A65000].End(xlUp).Row)
    If Cel <> "" Then
        Tmp = Split(Cel, "/")
        For I = LBound(Tmp) To UBound(Tmp)
            LesEntreprises(Trim(Tmp(I))) = LesEntreprises(Trim(Tmp(I))) + Cel.Offset(, -1)
        Next I
    End If
Next Cel
[D1].Resize(LesEntreprises.Count) = Application.Transpose(LesEntreprises.Keys)
[E1].Resize(LesEntreprises.Count) = Application.Transpose(LesEntreprises.Items)
End Sub

Bonne journée

[mouncefdi]

Bonjour mapeh,

merci pour ta reponse mais ca ne marche malheureusement pas du tout.

Je vous mets ci-joint un exemple de mon fichier comme ca, ca sera plus concret...

Merci beaucoup en tout cas

Cordialement,

[mapeh]

Bonjour,

Euh, tu ne m'aides pas beaucoup, par ces termes :

merci pour ta reponse mais ca ne marche malheureusement pas du tout.

Pour moi, dans ton fichier, cela fonctionne....

OK, je n'avais pas prévu le nettoyage, avant le déroulement du code

Essaie ainsi :

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
Sub entrep()
Dim Cel As Range
Dim I As Byte
Dim LesEntreprises As Object
Dim Tmp
Set LesEntreprises = CreateObject("Scripting.Dictionary")
Columns("D:E").ClearContents
For Each Cel In Range("B2:B" & [A65000].End(xlUp).Row)
    If Cel <> "" Then
        Tmp = Split(Cel, "*")
        For I = LBound(Tmp) To UBound(Tmp)
            LesEntreprises(Trim(Tmp(I))) = LesEntreprises(Trim(Tmp(I))) + Cel.Offset(, -1)
        Next I
    End If
Next Cel
[D1].Resize(LesEntreprises.Count) = Application.Transpose(LesEntreprises.Keys)
[E1].Resize(LesEntreprises.Count) = Application.Transpose(LesEntreprises.Items)
End Sub

PS, et si ce n'est pas cela que tu désires, prière de bien vouloir mettre ce que tu désires dans des cellules colorées..

Bonne journée