Discussion :

[esstin]

Bonjour,
J'ai un petit problème pour récupérer des données d'une matrice croisée dynamique. Sur cette matrice, en colonne figure les composants et en ligne les articles finis qui utilisent ces composants.
Je souhaiterais savoir pour chaque article le nombre de composant qu'il a en commun, ainsi que le nom de ces composant, avec tout les autres articles.
Par rapport à la matrice jointe :
Par exemple A a 3 composants en commun avec B (a,b,c)
A a 2 composants en commun avec C (a,b)
A a 3 composants en commun avec D et E (a,b,f)

Je voudrait savoir cela pour tout les articles entre eux.
Cette matrice n'est qu'un exemple car en réalité, il y a 660 articles différent et jusqu'à IN colonnes.

Pensez-vous que cela soit possible en macro?
Avez vous une idée qui peux fonctionner?

Je précise que je suis juste analyste de données et que je n'ai pas de notion de programmation.

Merci pour vos réponses et votre aide

[David2304]

Bonjour,

Essaye avec le code ci-dessous à insérer dans un module

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
Sub listing()
i = 1
For Each articles In Worksheets("Feuil1").Range("A2:A16")
    For Each articlesbis In Worksheets("Feuil1").Range("A2:A16")
        If articles = articlesbis Then
        Else
            nblignes = Worksheets("Feuil2").Range("A65536").End(xlUp).Row
            For Each listarticles In Worksheets("Feuil2").Range("A1:A" & nblignes)
                If articles = listarticles.Offset(0, 1).Value And articlesbis = listarticles Then
                GoTo suite
                End If
            Next
            nbcomposants = 0
            For j = 2 To 7
                If Worksheets("Feuil1").Cells(articles.Row, j) <> "" And Worksheets("Feuil1").Cells(articlesbis.Row, j) <> "" Then
                nbcomposants = nbcomposants + 1
                Worksheets("Feuil2").Cells(i, nbcomposants + 3) = Worksheets("Feuil1").Cells(1, j)
                End If
            Next
            If nbcomposants <> 0 Then
            Worksheets("Feuil2").Cells(i, 1) = articles
            Worksheets("Feuil2").Cells(i, 2) = articlesbis
            Worksheets("Feuil2").Cells(i, 3) = nbcomposants
            i = i + 1
            End If
        End If
suite:
    Next
Next
End Sub

[esstin]

Bonjour,

Essaye avec le code ci-dessous à insérer dans un module

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
Sub listing()
i = 1
For Each articles In Worksheets("Feuil1").Range("A2:A16")
    For Each articlesbis In Worksheets("Feuil1").Range("A2:A16")
        If articles = articlesbis Then
        Else
            nblignes = Worksheets("Feuil2").Range("A65536").End(xlUp).Row
            For Each listarticles In Worksheets("Feuil2").Range("A1:A" & nblignes)
                If articles = listarticles.Offset(0, 1).Value And articlesbis = listarticles Then
                GoTo suite
                End If
            Next
            nbcomposants = 0
            For j = 2 To 7
                If Worksheets("Feuil1").Cells(articles.Row, j) <> "" And Worksheets("Feuil1").Cells(articlesbis.Row, j) <> "" Then
                nbcomposants = nbcomposants + 1
                Worksheets("Feuil2").Cells(i, nbcomposants + 3) = Worksheets("Feuil1").Cells(1, j)
                End If
            Next
            If nbcomposants <> 0 Then
            Worksheets("Feuil2").Cells(i, 1) = articles
            Worksheets("Feuil2").Cells(i, 2) = articlesbis
            Worksheets("Feuil2").Cells(i, 3) = nbcomposants
            i = i + 1
            End If
        End If
suite:
    Next
Next
End Sub

Merci pour votre proposition mais on m'a proposé ailleurs un code qui fonctionne avec le nom des composants.
Merci beaucoup néanmoins

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
Option Explicit    ' Exige la déclaration explicite des variables.
 
Sub Synthese()
Dim L1 As Long, L2 As Long, LMax As Long, LS As Long, Cmax As Long
Dim C1 As Long, C2  As Long, N As Long, NA As Long
Dim NumF As Integer
Dim Resultat As String
Dim Tableau, aa
Application.ScreenUpdating = False
 
Resultat = "Resultat"
NumF = 1
Resultat = "Resultat" & NumF
Sheets("Resultat").Activate
Cells.ClearContents
 
Sheets("Feuil1").Activate
LMax = Range("A65536").End(xlUp).Row
Cmax = Range("IV1").End(xlToLeft).Column
 
Tableau = Range(Cells(1, 1), Cells(LMax, Cmax)) 'plage en tableau
 
LS = 2 ' init n° ligne résultat
For L1 = 2 To LMax 'pour chaque article niveau 1
Application.StatusBar = "Traitement ligne " & L1
If LS > (65000 - LMax) Then
    NumF = NumF + 1
    Resultat = "Resultat" & NumF
    Sheets(“Resultat”).Activate
    Cells.ClearContents
    LS = 2
  End If
NA = 1
For L2 = 2 To LMax 'pour chaque article niveau 2
    If L1 <> L2 Then
      N = 0
      For C1 = 2 To Cmax
          If Tableau(L1, C1) <> "" Then
            If Tableau(L2, C1) <> "" Then
                N = N + 1 ' nbre composant
                Sheets("Resultat").Cells(LS, 3 + N) = Tableau(1, C1)  ' composant commun
            End If
          End If
      Next
      If N <> 0 Then
          Sheets("Resultat").Cells(LS, 3) = N
          Sheets("Resultat").Cells(LS, 1) = Tableau(L1, 1)
          Sheets("Resultat").Cells(LS, 2) = Tableau(L2, 1)
          LS = LS + 1
      End If
    End If
Next L2
 
 
Next L1
Application.StatusBar = "Traitement teminé"
Application.ScreenUpdating = True
 
End Sub