Discussion :

[Kevdel]

Bonjour,

Je suis novice en VBA, j'aimerais convertir une nomenclature en Bom (liste de matériel).
En pièce jointe vous trouverez un exemple de fichier avec dans l'onglet 1 la nomenclature et l'onglet 2 la Bom que je souhaite obtenir.

Je ne sais pas du tout comment m'y prendre pour faire la recherche en VBA.

J'ai besoin que la macro recherche les articles commun de la colonne A pour transposer les répères topo dans la colonne B en séparant par des virgules et indique la quantité de repère dans la colonne C.

Pouvez-vous m'aider, s'il vous plait?

Merci par avance.

[zoltar_x]

Le plus simple, c'est de monter un tableau croisé dynamique (TCD) :

[Kevdel]

Merci pour ta réponse Zoltar

C'est ce que j'ai essayé mais ça ne correspond pas à mon attente.
J'ai besoin de l'imprimer de la même manière que dans la feuille Bom et de l'enregistrer en txt pour l'injecter dans un programme de développement machine.

[zoltar_x]

Voila le résultat que tu voulais.



Le point de départ est le TCD précédent qu'il faut copier et coller en texte dans une feuille.
Ici, c'est la première feuille du classeur :Worksheets(1).

Voici une façon de coder la chose (il y en a d'autres).

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
 
Sub test()
 
    Dim i As Long, k As Long
    Dim derniere_ligne  As Long, nb_lignes As Long
    Dim chaine As String
 
    Worksheets(1).Select
 
    derniere_ligne = Range("A1").End(xlDown).Row
 
    For i = 1 To derniere_ligne
        chaine = ""
        If Left(Trim(Cells(i, 1)), 2) = "F:" Or Left(Trim(Cells(i, 1)), 3) = "RS:" Then
            nb_lignes = Cells(i, 2)
                For k = 1 To nb_lignes
                    If k = 1 Then
                        chaine = chaine + Cells(i + k, 1)
                    Else
                        chaine = chaine + " , " + Cells(i + k, 1)
                    End If
                Next k
                Cells(i, 2) = chaine
                Cells(i, 3) = nb_lignes
        End If
    Next i
 
    For i = derniere_ligne To 1 Step -1
        If IsEmpty(Cells(i, 3)) Then
            Cells(i, 3).EntireRow.Delete
        End If
    Next i
 
End Sub

[Qwazerty]

Salut

Etape 1 : Transforme le tableau contenant les donnée en Tableau Structuré (menu Insertion... Tableau)
Etape 2 : Place ce code dans un Module (standard) sous VBE
Etape 3 : exécute le 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
44
45
46
47
48
49
Option Explicit
 
Sub Nomenc()
Dim NewSh As Worksheet
Dim Dico As New Dictionary 'Object 'Si tu ne souhaites pas activer Scripting Runtime [Outil, Références...]
Dim iRow As Integer
Dim CA As String
Dim TmpV As Variant
 
    'On instancie le dico ...Si tu ne souhaites pas activer Scripting Runtime [Outil, Références...]
    'Set Dico = CreateObject("Scripting.Dictionary")
 
 
    'On pointe le tableau de donnée
    With Feuil1.ListObjects("Tab_Article")
        'On boucle sur les lignes
        For iRow = 1 To .ListRows.Count
            'On Compléte le dico
            CA = .DataBodyRange(iRow, .ListColumns("Code Article").Index)
            If Dico(CA) <> "" Then Dico(CA) = Dico(CA) & ","
            Dico(CA) = Dico(CA) & .DataBodyRange(iRow, .ListColumns("Repère").Index)
        Next
    End With
 
    'On Crée le BOM si des données sont présentes
    If Dico.Count > 0 Then
        'On ajoute un onglet
        Set NewSh = ThisWorkbook.Worksheets.Add
 
        'On pointe le nouvel onglet
        With NewSh
            'On place l'entête
            .Range("A1:C1").Value = Array("Code article", "Repères", "Qté")
            'On crée un tableau structuré et on le pointe
            With .ListObjects.Add(xlSrcRange, .Range("A1:C1"), , xlYes)
                'On boucle sur le contenu du dico
                For iRow = 0 To Dico.Count - 1
                    'On ajoute une ligne et on la pointe
                    With .ListRows.Add
                        'On place les infos
                        .Range(1, 1) = Dico.Keys(iRow)
                        .Range(1, 2) = Dico.Items(iRow)
                        .Range(1, 3) = UBound(Split(Dico.Items(iRow), ",")) + 1
                    End With
                Next
            End With
        End With
    End If
End Sub

++
Qwaz

[Qwazerty]

Salut

Voila le résultat que tu voulais.

En comparant vite fait, je vois que certaines lignes n'ayant pas Repère n'apparaissent pas dans la liste de zoltar, probablement éliminées par le TCD.
@Kevdel : Que souhaites tu lorsque aucun repère n'est précisé?

++
Qwaz

[Kevdel]

Je vous remercie beaucoup pour votre aide c'est exactement ce dont j'ai besoin.
Pour les code sans repère, on peut écrire "NC" et qté "0".

Encore un grand merci

[Kevdel]

@Qwazerty, par contre quand je met ton code dans un module VBA, j'ai une erreur sur la ligne Dim Dico As New Dictionary
j'ai remplacé New dictionary par Object mais maintenant j'ai une erreur sur la ligne "With Feuil1.ListObjects("Tab_Article")"

Que dois-je faire? stp

[Qwazerty]

Salut

Tu as bien activé cette ligne ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    Set Dico = CreateObject("Scripting.Dictionary")

++
Qwaz

[Kevdel]

Salut,

Oui je l'ai activé et j'ai toujours l'erreur sur la ligne With Feuil1.ListObjects("Tab_Article").
Je ne comprends pas, est ce que tu pourrais faire un modèle sur le fichier de base pour voir si ça fonctionne et le mettre en pièce jointe, s'il te plait?

Merci

[Qwazerty]

Salut

Un effort de compréhension ne nuirait quand même pas....

Il faut adapter "Feuil1" et le nom du tableau....

++
Qwaz

[Kevdel]

Salut,

Merci, pour la pièce jointe.
Je en comprend pas, sur mon fichier d'origine j'ai essayé de mettre en forme le tableau, renommer les pages les colonnes... ça ne fonctionnait pas.

Encore merci