Aide pour macro de recherche et copie de lignes entière en utilisant un dictionnaire

**magicsismic** · 04/04/2015, 16h45

j'ai un code qui me permet de rechercher rapidement la valeur "Obsolète" dans la colonne AC et de récupérer les résultats dans une Listbox mais ce que j'aimerais c'est pouvoir récupérer la ligne entière sachant que le nombre de colonne est variable

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
Sub recherchearchive2()
Dim dico As Object
Dim vMsn As Variant
Dim Last_date As Date
Dim Last_objet As String
Dim a(), b(), c()
Dim i As Long, j As Long, n As Long
Dim lastrow As Long
Dim tblo As Variant
Dim tblo2()
Dim Temp()
Dim ligne As Long
Dim Critere1 As String
UserForm2.ListBox3.Clear
Application.ScreenUpdating = False
DoEvents
rechercheobsolete
'**************statut**********************
Critere1 = "Obsolète"
 
 
lastrow = ThisWorkbook.Sheets("Cvtheque").Range("A" & Rows.Count).End(xlUp).Row
Temp = ThisWorkbook.Sheets("Cvtheque").Range("A1:AC" & lastrow).Value
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Temp, 1)
        If Temp(i, 29) Like Critere1 Then
            If dico.Exists(Temp(i, 1) & " | " & Temp(i, 14)) = False Then
                'on ajoute dnas le dico l'objet inexistant
                dico(CStr(Temp(i, 1)) & "|" & CStr(Temp(i, 14))) = CStr(Temp(i, 14)) & "|" & CStr(Temp(i, 15)) & "|" & CStr(Temp(i, 4)) & "|" & CStr(Temp(i, 2)) & "|" & CStr(i)
            End If
        End If
        Next i
 
'extraction du resultat
 n = dico.Count
If n > 0 Then
ReDim c(1 To n, 1 To 5)
UserForm2.ALarchive.Visible = False
ElseIf n = 0 Then
UserForm2.ALarchive.Visible = True
Exit Sub
End If
 
  a = dico.Keys
  b = dico.Items
  For j = 1 To n
 
  'c(i, 1) = a(i - 1)
  c(j, 1) = Split(b(j - 1), "|")(0)
  c(j, 2) = Split(b(j - 1), "|")(1)
  c(j, 3) = Split(b(j - 1), "|")(2)
  c(j, 4) = Split(b(j - 1), "|")(3)
  c(j, 5) = Split(b(j - 1), "|")(4)
 
  Next j
  Call tri(c(), 1, LBound(c, 1), UBound(c, 1))
UserForm2.ListBox3.ColumnCount = 4
 
  UserForm2.ListBox3.List = c
  UserForm2.Repaint
  UserForm2.LBLwait.Visible = False
Application.ScreenUpdating = True
End Sub

j'ai modifié le début du code pour récupérer uniquement les numéros de lignes qui m'intéressent mais après je vois pas comment alimenter mon tableau c parcourant toutes les lignes dont le numéro est dans le dictionnaire. Voici le début du code modif

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
Dim dico As Object
Dim vMsn As Variant
Dim Last_date As Date
Dim Last_objet As String
Dim a(), b(), c As Variant, k&
Dim i As Long, j As Long, n As Long
Dim lastrow As Long
Dim tblo As Variant
Dim tblo2()
Dim Temp()
Dim dercol As Long
Dim ligne As Long
Dim Critere1 As String
UserForm2.ListBox3.Clear
Application.ScreenUpdating = False
DoEvents
rechercheobsolete
'**************statut**********************
Critere1 = "Obsolète"
 
 
lastrow = ThisWorkbook.Sheets("Cvtheque").Range("A" & Rows.Count).End(xlUp).Row
dercol = ThisWorkbook.Sheets("Cvtheque").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
ThisWorkbook.Sheets("Cvtheque").Activate
Temp = ThisWorkbook.Sheets("Cvtheque").Range(Cells(1, 1), Cells(lastrow, dercol)).Value
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Temp, 1)
        If Temp(i, 29) Like Critere1 Then
            If dico.Exists(Temp(i, 1)) = False Then
                'on ajoute dnas le dico l'objet inexistant
                dico(CStr(Temp(i, 1)) & "|" & CStr(Temp(i, 14))) = CStr(i)
            End If
        End If
        Next i

j'avais pensé à faire un truc du genre :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
 n = dico.Count
If n > 0 Then
ReDim c(1 To n, 1 To 5)
UserForm2.ALarchive.Visible = False
ElseIf n = 0 Then
UserForm2.ALarchive.Visible = True
Exit Sub
End If
b=dico.items
for j=1 to n
c=thisworkbook.sheets("Cvtheque").range(cells(b(j-1),1)cells(b(j-1),dercol)).value
next j

mais seule la première ligne apparaît, auriez-vous une idée ?

**gnain** · 04/04/2015, 19h17

Bonjour,
ceci n'est rien que un exemple, à adapter à ton projet.

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
Sub test()
 
    Dim arrLstBox(1 To 100, 1 To 50)
    ListBox5.ColumnCount = 50
    Ligne_Listbox = 1
    Set q = Range("AC1:AC" & Cells(Rows.Count, "AC").End(xlUp).Row).Find("Obsolète")
    F = q.Address
 
    Do
 
        arrLstBox(Ligne_Listbox, 1) = q.Value
        arrLstBox(Ligne_Listbox, 2) = q.Offset(0, -1).Value ' colonne AB
        arrLstBox(Ligne_Listbox, 3) = q.Offset(0, -2).Value ' colonne AA
        arrLstBox(Ligne_Listbox, 4) = q.Offset(0, -3).Value ' colonne Z
        arrLstBox(Ligne_Listbox, 5) = q.Offset(0, -4).Value ' colonne Y
        arrLstBox(Ligne_Listbox, 6) = q.Offset(0, 1).Value ' colonne AD
        arrLstBox(Ligne_Listbox, 7) = q.Offset(0, 2).Value ' colonne AE
        arrLstBox(Ligne_Listbox, 8) = q.Offset(0, 3).Value ' colonne AF
        arrLstBox(Ligne_Listbox, 9) = q.Offset(0, 4).Value ' colonne AG
        '..... et on continue
 
        Ligne_Listbox = Ligne_Listbox + 1
        Set q = Range("C9:C" & Cells(Rows.Count, "C").End(xlUp).Row).FindNext(q)
 
    Loop While Not q Is Nothing And q.Address <> F
 
    ListBox5.List = arrLstBox()
 
End Sub

**magicsismic** · 04/04/2015, 20h49

bonjour gnain et merci pour ta réponse
elle aurait été parfaite si je connaissait le nombre de colonnes et de lignes mais le nombre de colonnes et de lignes peuvent varier.
il faudrait que j'arrive à alimenter un tableau mais dynamique du genre Dim arrLstBox() par le nombre de lignes entières trouvées. tu crois que c'est possible ?

**gnain** · 04/04/2015, 20h54

Voir
ReDim pour redimensionné le tableau à volonté

**magicsismic** · 04/04/2015, 21h08

il faudrait donc que je fasse

Code :

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

redim arrlistbox (1 to q.row, 1 to dercol)

dans la boucle do où dercol représente la dernière colonne non vide. C'est çà ?

**gnain** · 04/04/2015, 23h00

Bonjour,
comme cela

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
 
    Dim arrLstBox()
    ListBox5.ColumnCount = 50
    Ligne_Listbox = 1
    Set q = Range("AC9:AC" & Cells(Rows.Count, "AC").End(xlUp).Row).Find("Obsolète")
    F = q.Address
    Do
 
        Ligne_Listbox = Ligne_Listbox + 1
        Set q = Range("AC9:AC" & Cells(Rows.Count, "AC").End(xlUp).Row).FindNext(q)
        ReDim arrLstBox(1 To Ligne_Listbox, 1 To dercol)
    Loop While Not q Is Nothing And q.Address <> F
 
    Ligne_Listbox = 1
 
    Do
 
        arrLstBox(Ligne_Listbox, 1) = q.Value
        arrLstBox(Ligne_Listbox, 2) = q.Offset(0, -1).Value ' colonne AB
        arrLstBox(Ligne_Listbox, 3) = q.Offset(0, -2).Value ' colonne AA
        arrLstBox(Ligne_Listbox, 4) = q.Offset(0, -3).Value ' colonne Z
        arrLstBox(Ligne_Listbox, 5) = q.Offset(0, -4).Value ' colonne Y
        arrLstBox(Ligne_Listbox, 6) = q.Offset(0, 1).Value ' colonne AD
        arrLstBox(Ligne_Listbox, 7) = q.Offset(0, 2).Value ' colonne AE
        arrLstBox(Ligne_Listbox, 8) = q.Offset(0, 3).Value ' colonne AF
        arrLstBox(Ligne_Listbox, 9) = q.Offset(0, 4).Value ' colonne AG
        '.....ainsi de suite
 
        Ligne_Listbox = Ligne_Listbox + 1
        Set q = Range("AC9:AC" & Cells(Rows.Count, "AC").End(xlUp).Row).FindNext(q)
 
    Loop While Not q Is Nothing And q.Address <> F
 
    ListBox5.List = arrLstBox()

Aide pour macro de recherche et copie de lignes entière en utilisant un dictionnaire [XL-2013]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager