Discussion :

[Pulco74]

Bonjour à tous,

J'ai un problème avec un fichier excel-2016, et étant néophyte en VBA je n'arrive pas à trouver une solution. Ne trouvant pas de réponses sur les forums, je me permet de vous le soumettre.

Plusieurs éditeurs vont m'envoyer des classeurs Excels types :
Colonne A : Article
Colonne B : Prix
Il y aura d'autres colonnes avec d'autres infos

Après avoir réuni toutes les feuilles dans un classeur, j'aimerais programmer une macro qui compile toutes les colonnes A (donc les articles) dans une feuille récapitulative : certains articles seront dans plusieurs feuilles et donc il faut supprimer les doublons.

Ensuite, dans cette feuille récapitulative, j'aimerais créer une colonne par feuille de donnée que j'ai, et qui indique le prix de l'article si elle le vend.

J'arrive a peu près a réunir les articles et supprimer les doublons, mais programmer une macro qui compte les feuilles de sources, qui créer une colonne pour chaque feuille et qui me fait une rechercheV, c'est galère...

J'espère avoir été assez clair, je peux vous fournir un fichier d'exemple !

PS : Connaissant un peu PowerPivot, je me dis que cela pourrait être plus adapté, des avis ?

Merci d'avance

Jean-Philip

[BENNASR]

Bonjour
A mon modeste avis tu peux procéder différemment en important tous les article en colonne A et En colonne B les prix et en Colonne C la source qui correspond au nom de la feuille et puis tu peux à l'aide d'un tableau croisé dynamique (en ligne les article / en colonne la source / et en valeur les prix )
si ça t'arrange voila une piste à adapter...si non on va voir ce qu'on peux faire ... BONNE CONTINUATION

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
Sub collecterDonnées()
Application.ScreenUpdating = False 'juste pour arrêter affichage écran et améliorer le temps d'exécution du macro
Dim derligneS As Long
Dim derligneR As Long
Dim j As Long
Dim K As Long
j = 2
With Sheets("RECAPITULATIF")
derligneR = .Range("A" & Rows.Count).End(xlUp).Row
'*********************************************vider les ligne à partir de la ligne 5
.Range("A2:B" & derligneR).ClearContents
 ' *****************************************Importer les données dans la feuille RECAP
 .Cells(1, 1).Resize(1, 3) = Array("Article", "Prix", "Source")
 
 For i = 1 To Worksheets.Count
 j = .Range("A" & Rows.Count).End(xlUp).Row + 1
        If Worksheets(i).Name <> "RECAPITULATIF" Then
            derligneS = Worksheets(i).Range("A" & Rows.Count).End(xlUp).Row
            For K = 2 To derligneS
            .Range("A" & j) = Worksheets(i).Range("A" & K)
            .Range("B" & j) = Worksheets(i).Range("B" & K)
            .Range("C" & j) = Worksheets(i).Name
            j = j + 1
            Next K
            K = 0
        End If
    Next i
End With

[BENNASR]

Pour regrouper sans doublons vous pouvez faire avec un dictionnaire

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
Sub collecterDonnées()
Application.ScreenUpdating = False 'juste pour arrêter affichage écran et améliorer le temps d'exécution du macro
 
'************************************************************************************************************************
 Dim Plage As Range
    Dim Cel As Range
    Dim Dico As Object
    Dim Cle As Variant
    Dim L
    Dim I As Integer
    Dim j As Integer
 
With Sheets("RECAPITULATIF")
derligneR = .Range("A" & Rows.Count).End(xlUp).Row
'*********************************************vider les ligne à partir de la ligne 5
.Range("A2:B" & derligneR).ClearContents
 .Cells(1, 1).Resize(1, 3) = Array("Article", "Prix", "Source")
 ' *****************************************Importer les données dans la feuille RECAP
 End With
 Set Dico = CreateObject("Scripting.Dictionary")
 For j = 1 To Worksheets.Count
        If Worksheets(j).Name <> "RECAPITULATIF" Then
        Set Plage = Worksheets(j).Range(Worksheets(j).Cells(2, 1), Worksheets(j).Cells(Worksheets(j).Rows.Count, 1).End(xlUp))
        For Each Cel In Plage: Dico(Cel.Value) = Dico(Cel.Value) & Cel.Offset(, 1).Value & ";" & Worksheets(j).Name & ";": Next Cel
        End If
  Next j
         Cle = Dico.Keys
 
    With Sheets("RECAPITULATIF")
      For I = 0 To Dico.Count - 1
        L = Split(Dico(Cle(I)), ";")
        .Cells(I + 2, 1).Value = Cle(I)
        .Cells(I + 2, 2).Value = L(0)
        .Cells(I + 2, 3).Value = L(1)
    Next
 
End With
MsgBox ("Regroupement effectué avec succès .... ")
Application.ScreenUpdating = True
End Sub

[Pulco74]

Merci infiniment pour votre temps BENNASR, j'aime beaucoup cette méthode et ça marche impeccable ! Je vais approfondir cette idée du dictionnaire mais avec cette méthode je ne devrais pas en avoir besoin.

Bonne journée !