Simplifier code à l'aide de variables tableaux

Version imprimable

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:

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:

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 :) !

15/03/2016, 20h59
mercatog

Une autre piste, utiliser les filtres d'excel
15/03/2016, 21h44
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 :D
15/03/2016, 22h15
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/
15/03/2016, 22h33
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 :oops:
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 :)!

Regardes ceci

Code:

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

16/03/2016, 11h41
Alasgard

Merci de ton aide, c'est parfait :D

Cependant, je me demandais 2-3 petites choses.

Pourquoi redimensionner la plage avec un resize tandis que l'on pourrait également faire un Set plage=... ?
Je suppose qu'il y'a une explication logique mais si tu pouvais me renseigner, ce serait top :)

Ensuite, je me demandais pourquoi Tb et Pièces étaient déclarés en Variant et non pas comme un tableau avec les parenthèses (exemple Res()).
Il me semble que pour cette dernière je trouverai la réponse dans le tuto de silkyroad, je revérifierai ce soir!

Je mets le sujet en résolu,
Merci de ton aide en tout cas :)!