Discussion :

[deb_5588]

Bonjour à vous!

Je me permets de vous soumettre une question.
En effet, ayant jusqu'à présent réussi à me débrouiller sur Excel (en utilisant occasionnellement contourner VBA) ; cet outil me semble aujourd'hui incontournable ; et malgré des recherches sur les différents forum, je n'ai pas trouvé de réponse.

En effet, j'ai une base de données dont les codes de référence (identifiant chaque ligne) sont assez complexe (mélant chiffres et lettres et autres caractères spéciaux (points, virgules...)).

De cette base de donnée, je souhaiterais extraire les lignes:
1/ du code de référence recherché (dans le fichier joint le numéro "3")
2/ de la référence mère (2)
3/ des références qui en découlent (4.a, 4.b, 4.c)

La base de donnée est assez longue et et il peut y avoir plusieurs références mères, et pluisieurs références qui découlent de la référence principale.

Au cas où cet exposé manquerait de clareté, voici un fichier test en PJ.

Merci bcp!!!

Déb

[Kimy_Ire]

Juste une question : quand tu parles de base de données, tu veux faire une requète serveur/SQL depuis ta macro VBA ? Ou ce que tu appelles BDD, c'est une autre fichier Excel ?

[deb_5588]

Salut Kimy,

La base de donnée est sur le même fichier Excel, sur une autre feuille (dans le fichier test sur la même feuille).
Il faut donc exporter certaines lignes de cette feuille vers une autre feuille de ce même fichier Excel

[Kimy_Ire]

Bon... Que veux-tu extraires ?

Tu souhaites lancer une Macro qui affiche une box, dans laquelle tu rentres quelque chose, mais je n'arrive pas à déterminer ce quelque chose... C'est le code ? (Dans ton fichier exemple 3 ?)
Ensuite la référence mère est la référence qui à en sous-code la référence recherchée ?
Enfin, les références qui en découlent sous les sous-codes de la référence recherchée ?

Voila le code que je te propose :

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Sub Extract_data_base()
Dim ref As Integer
Dim cell_ref As Range
Dim rowmax As Integer
Dim cell_sc As Range
Dim off1 As Integer
Dim off2 As Integer
Dim str As String
Dim table() As String
 
ref = InputBox("Référence recherchée ?", "Référence", 0)
 
With Worksheets("Data")
    Set cell_ref = .Columns(2).Find(ref, LookIn:=xlFormulas, lookat:=xlWhole)
    If cell_ref Is Nothing Then
        MsgBox "La référence n'a pas été trouvée"
        Exit Sub
    End If
 
    rowmax = 0
    For i = 0 To 2
        test = Worksheets("Export").Columns(1 + (i * 4)).Find("*", , , , xlByColumns, xlPrevious).Offset(1, 0).Row
        If Worksheets("Export").Columns(1 + (i * 4)).Find("*", , , , xlByColumns, xlPrevious).Offset(1, 0).Row > rowmax Then
            rowmax = Worksheets("Export").Columns(1 + (i * 4)).Find("*", , , , xlByColumns, xlPrevious).Offset(1, 0).Row
        End If
    Next i
    Set cell_des = Worksheets("Export").Cells(rowmax, 1)
 
    For i = 0 To 3
        cell_des.Offset(0, i) = cell_ref.Offset(0, i - 1)
    Next i
 
    Set cell_sc = .Columns(4).Find(ref, LookIn:=xlFormulas, lookat:=xlWhole)
 
    If Not cell_sc Is Nothing Then
        For i = 0 To 3
            cell_des.Offset(0, i + 4) = cell_sc.Offset(0, i - 3)
        Next i
 
        ReDim table(1 To 1)
        off1 = 0
        off2 = 0
        If cell_ref.Offset(0, 2) <> "" Then
            If InStr(cell_ref.Offset(0, 2), ",") Then
                off1 = InStr(cell_ref.Offset(0, 2), ",")
                table(1) = Left(cell_ref.Offset(0, 2), off1 - 1)
 
                For i = 2 To 100
                    If InStr(off1 + 1, cell_ref.Offset(0, 2), ",") Then
                        off2 = InStr(off1 + 1, cell_ref.Offset(0, 2), ",")
                        ReDim Preserve table(1 To i)
                        table(i) = Mid(cell_ref.Offset(0, 2), off1 + 2, off2 - off1 - 2)
                        off1 = off2
                    Else
                        ReDim Preserve table(1 To i)
                        table(i) = Right(cell_ref.Offset(0, 2), Len(cell_ref.Offset(0, 2)) - off1 - 1)
                        Exit For
                    End If
                Next i
            Else
                table(1) = cell_ref.Offset(0, 2)
            End If
        End If
 
    '    strMessage = ""
    '    For boucle = 1 To UBound(table)
    '        strMessage = strMessage & table(boucle) & vbLf
    '    Next boucle
    '
    '    MsgBox strMessage
 
        For i = 0 To UBound(table) - 1
            Set cell_sc = .Columns(2).Find(table(i + 1), LookIn:=xlFormulas, lookat:=xlWhole)
            For j = 0 To 3
                cell_des.Offset(i, j + 8) = cell_sc.Offset(0, j - 1)
            Next j
        Next i
    End If
 
End With
 
End Sub

Je pensais que ça serait plus simple ! ^^
Peu importe, voila les conditions d'utilisation :
1) Il faut que ta feuille origine s'appelle "Data" et ta feuille destination ""Export". Change dans le code si tu veux des noms différents. Sache également que ces deux feuilles doivent être dans le même classeur !
2) Lance ta Macro et insère la référence que tu veux.
3) Je fais une recherche de référence sur la deuxième colonne (comme dans ton fichier exemple).
4) Si je trouve la référence, je la place sur la dernière ligne disponible en comparant les colonnes A, E et I dans ta feuille "Export".
5) Je place les valeurs sur les colonnes A à D du fichier "Export".
6) Je fais une recherche ensuite sur la sous référence sur la colonne D de ton fichier "Data".
7) Si je trouve un fichier parent, je le place sur les colonnes E à H du fichier 'Export".
8) Enfin je regarde la/les références fichiers enfants. S'il y en a plusieurs, ILS DOIVENTS ETRE SOUS LA FORME DECRIRE : c'est-a-dire "code1, code2, code3, code4, etc..." avec les virgules et les espaces comme précisés dans le fichier exemple.
9) Enfin je fais une recherche de ces fichiers enfants et je les places sur les colonnes I à L de la feuille "Export".

Bref, fait tes tests et reviens vers moi si tu as la moindre difficulté.

PS : Au final, place le tableau "Table Extraction" sur les colonnes A à L dans une feuille "Export" tout en renomant ta feuille origine par "Data" et lance ta macro !