Discussion :

[Alasgard]

Bonjour à tous,

Je poste sur le forum afin d'obtenir de l'aide concernant un problème sur lequel je me casse la tête.

J'ai réalisé le code suivant qui me permet de parcourir une plage composée de kits.
A chaque nouvelle valeur (chaque kit), j'effectue une recherche dans une autre feuille afin d'identifier les pièces qui composent ce kit.
Un kit peut avoir plusieurs pièces, de ce fait, je réalise une boucle "Do ...Loop While". Tant que la valeur du kit de la ligne actuelle est identique à la valeur du kit de la ligne suivante, on poursuit le parcours des pièces.
Ensuite je colle dans une feuille "Recap'", le kit avec chacune de ses pièces.

Le problème est que je parcours des plages assez grandes (jusqu'à 1000 kits différents), ce qui fait que ma feuille récap dépasse facilement les 10 000 lignes.
Et parcourir ces lignes est long avec 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
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
Dim Kit, DescriptionKit, Pieces, Outils As String
Dim i As Integer
Dim cell, x, Plage As Range
 
'''''''''''''''''''''''Récupération des données''''''''''''''''''''''''''''''
Application.ScreenUpdating = False
 
With Sheets("Principale")
i = 2
.Activate
Fin = .Range("A65536").End(xlUp).Row
Set Plage = Sheets("Principale").Range(Cells(1, 1), Cells(Fin, 1))
 
    For Each cell In Plage
    Kit = cell
    LigneDesc = cell.Row
    DescriptionKit = .Cells(LigneDesc, 2)
 
        With Sheets("FeuillePiece").[A1:Z65536]
        Set x = .Find(What:=Kit, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
        j = 0
            If Not x Is Nothing Then
            Ligne = x.Row
                Do
                Pieces = .Cells(Ligne, 3)
                Sheets("Recap").Range("A" & i + j) = Kit
                Sheets("Recap").Range("B" & i + j) = DescriptionKit
                Sheets("Recap").Range("C" & i + j) = "-"                
                Sheets("Recap").Range("D" & i + j) = Pieces
                Ligne = Ligne + 1
                    If Sheets("FeuillePiece").Cells((Ligne - 1), 1).Value = Sheets("FeuillePiece").Cells(Ligne, 1).Value And Sheets("FeuillePiece").Cells(Ligne, 1).Value <> "" Then
                    j = j + 1
                    End If
                Loop While Sheets("FeuillePiece").Cells((Ligne - 1), 1).Value = Sheets("FeuillePiece").Cells(Ligne, 1).Value And Sheets("FeuillePiece").Cells(Ligne, 1).Value <> ""
                i = i + j
                Set x = Nothing
                i = i + 1
            Else
            End If
        End With
	Next
End With
End Sub

De ce fait, j'ai tenté de rajouter des variables tableau, mais je ne maitrise pas trop ces variables et j'ai le sentiment de ne pas prendre le bon chemin, d'où ma venue ici.
Voici le code que j'ai fait et qui n'est pas terminé (et donc non fructueux):

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
Sub Test()
 
Dim Kit, DescriptionKit, Pieces, Outils As StringDim i As Integer
Dim cell, x, Plage As Range
Dim Tableau(), data As Variant
Dim cpt1 As Long, cpt2 As Long
 
'''''''''''''''''''''''Récupération des données''''''''''''''''''''''''''''''
Application.ScreenUpdating = False
 
With Sheets("Principale")
i = 2
.Activate
Fin = .Range("A65536").End(xlUp).Row
Set Plage = Sheets("Principale").Range(Cells(1, 1), Cells(Fin, 1))
 
data = .[A1].Resize(Cells(Rows.Count, 1).End(xlUp).Row + 1, 5).Value
ReDim Tableau(1 To UBound(data, 1), 1 To UBound(data, 2))
	For lig = 1 To UBound(data)
    Kit = data(lig, 1)
    LigneDesc = lig
    DescriptionKit = data(LigneDesc,2)
        With Sheets("FeuillePiece").[A1:Z65536]
        Set x = .Find(What:=Kit, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
        j = 0
            If Not x Is Nothing Then
            Ligne = x.Row
                Do
                Pieces = .Cells(Ligne, 3)
                Sheets("Recap").Range("A" & i + j) = Kit
                Sheets("Recap").Range("B" & i + j) = DescriptionKit
                Sheets("Recap").Range("C" & i + j) = "-"                
                Sheets("Recap").Range("D" & i + j) = Pieces
                Ligne = Ligne + 1
                    If Sheets("FeuillePiece").Cells((Ligne - 1), 1).Value = Sheets("FeuillePiece").Cells(Ligne, 1).Value And Sheets("FeuillePiece").Cells(Ligne, 1).Value <> "" Then
                    j = j + 1
                    End If
                Loop While Sheets("FeuillePiece").Cells((Ligne - 1), 1).Value = Sheets("FeuillePiece").Cells(Ligne, 1).Value And Sheets("FeuillePiece").Cells(Ligne, 1).Value <> ""
                i = i + j
                Set x = Nothing
                i = i + 1
            Else
            End If
        End With
    Next lig
End With
End Sub

Si vous pouviez m'aider à simplifier tout ça, je vous en serai très reconnaissant !

[mercatog]

Une autre piste, utiliser les filtres d'excel

[Alasgard]

De quelle façon ?
Je sais comment utiliser les filtres élaborés mais je ne vois pas comment dans ce cas!

Et je t'avoue qu'obtenir un code avec l'utilisation des variables tableaux m'intéresse afin de pouvoir apprendre comment les utiliser au mieux avec un exemple que je connais bien

[mercatog]

Pour chaque Kit de la feuille Principale, fais un filtre automatique sur le feuille FeuillePiece et récupère les pièces à partir des lignes visibles

Sinon http://silkyroad.developpez.com/vba/tableaux/
ou bien http://didier-gonard.developpez.com/...s-tableau-vba/

[Alasgard]

Je vais regarder avec les filtres dès demain , je mettrai à jour le sujet en fonction de ma réussite ou non.

Concernant les tutos, ils sont dans mes favoris depuis 1 mois , ils m'ont beaucoup aidé à appréhender les variables tableaux mais je n'ai pas réussi à faire mieux que ce que j'ai présenté dans mon premier post
J'y passe beaucoup de temps avec peu de réussite :/

D'où ma demande d'aide, qui comme je le disais me permettrait surement de mieux comprendre et d'utiliser d'une meilleure façon les variables tableaux car je connais très bien le code que je veux adapter.

Merci pour tes réponses en tout cas !

[mercatog]

Regardes ceci

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 Test()
Dim Fin As Long, i As Long, j As Long, k As Long
Dim Res() As String
Dim Tb, Pieces
 
Application.ScreenUpdating = False
With Worksheets("FeuillePiece")
    Fin = .Cells(.Rows.Count, 1).End(xlUp).Row
    Pieces = .Cells(1, 1).Resize(Fin, 3)
End With
 
With Worksheets("Principale")
    Fin = .Cells(.Rows.Count, 1).End(xlUp).Row
    Tb = .Cells(1, 1).Resize(Fin)
End With
 
For i = 1 To Fin
    For j = 1 To UBound(Pieces, 1)
        If Tb(i, 1) = Pieces(j, 1) Then
            k = k + 1
            ReDim Preserve Res(1 To 4, 1 To k)
            Res(1, k) = Tb(i, 1)
            Res(2, k) = Tb(i, 2)
            Res(3, k) = "-"
            Res(4, k) = Pieces(j, 1)
        End If
    Next j
Next i
Worksheets("Recap").Range("A2").Resize(k, 4) = Application.Transpose(Res)
End Sub