Discussion :

[idefix007]

Bonjour à tous,

Je suis nouvelle en VBA.
Je vais essayer d'être la plus claire possible.

Dans ma feuille Sim Ro, j'ai deux filtres à effectuer sur 2 colonnes.
Le premier filtre est de retrouver dans la colonne A tous les articles se terminant par 465-02.
Le format de ces articles est soit xxx/xxx-xx soit xxxxx/xxx-xx soit xxxxxx/xxx-xx.
Exemple 1: 751/652-03
Exmeple 2 : 75133/652-03

Le deuxième filtre est de retrouver dans la colonne B tous les services comprenant "PERS"
On devrait donc pouvoir retrouver les services "PERS" mais aussi "IP / PERS" par exemple.

Le résultat devrait être reporté à partir de la ligne 10 de la colonne A dans ma feuille Res.

J'avais d'abord utilisé des if then et des boucles for. Cela fonctionnait mais ce n'était pas très optimal et j'avais certains de mes articles qui n'apparaissaient pas (à cause des espaces en fin de texte dans la barre d'adresse je pense). Le fichier final aura beaucoup de données et j'aimerais diminuer le temps de traitement. J'ai commencé donc à m'intéresser aux tableaux en mémoire. Dans mes recherches je suis tombée sur ce site http://boisgontierjacques.free.fr/index2.htm qui m'a déjà beaucoup aidée et dans lequel j'ai trouvé la fonction FiltreMultiCol2 reprise dans mon code.

J'ai essayé plusieurs méthodes (comme le right ou de mettre des * dans mes guillemets) mais cela ne fonctionne pas.


Merci par avance pour votre aide et explications.

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 essaiFiltre2cond()
 
 
'Sheets("Result").Select
   Set f = Sheets("Sim RO")
 
   Tbl = f.Range("A3:G" & f.[A65000].End(xlUp).Row).Value
 
   Clé1 = "465-02": colClé1 = 1
   Clé2 = "PERS": colClé2 = 2
    b = FiltreMultiCol2(Tbl, colClé1, Clé1, Array(1), colClé2, Clé2, 1)
   If Not IsEmpty(b) Then Sheets("res").[A10].Resize(UBound(b), UBound(b, 2)) = b
 
End Sub
 
Function FiltreMultiCol2(Tbl, colClé1, Clé1, ColResult, Optional colClé2, Optional Clé2, Optional ColTri)
  ligne = 1
  If IsMissing(colClé2) Then colClé2 = colClé1: Clé2 = Clé1
  For i = LBound(Tbl) To UBound(Tbl)
    If Tbl(i, colClé1) = Clé1 And Tbl(i, colClé2) = Clé2 Then n = n + 1
  Next i
  Dim b()
  If n > 0 Then
    If IsArray(ColResult) Then
      ReDim b(LBound(Tbl) To n, LBound(ColResult) + 1 To UBound(ColResult) - LBound(ColResult) + 1)
    Else
      ReDim b(LBound(Tbl) To n, 1 To 1)
    End If
    For i = LBound(Tbl, 1) To UBound(Tbl, 1)
     If Tbl(i, colClé1) = Clé1 And Tbl(i, colClé2) = Clé2 Then
      If IsArray(ColResult) Then
        For c = LBound(ColResult) To UBound(ColResult)
          col = ColResult(c)
          b(ligne, c + 1) = Tbl(i, col)
        Next c
      Else
        b(ligne, ColResult) = Tbl(i, ColResult)
      End If
      ligne = ligne + 1
    End If
   Next i
   If Not IsMissing(ColTri) Then Call TriCol(b, LBound(b), UBound(b), ColTri)
   FiltreMultiCol2 = b
  End If
End Function
Sub TriCol(a(), gauc, droi, ColTri)         ' Quick sort
 Ref = a((gauc + droi) \ 2, ColTri)
 g = gauc: d = droi
 Do
     Do While a(g, ColTri) < Ref: g = g + 1: Loop
     Do While Ref < a(d, ColTri): d = d - 1: Loop
     If g <= d Then
       For col = LBound(a, 2) To UBound(a, 2)
          temp = a(g, col): a(g, col) = a(d, col): a(d, col) = temp
       Next col
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call TriCol(a, g, droi, ColTri)
 If gauc < d Then Call TriCol(a, gauc, d, ColTri)
End Sub

[Invité]

Bonjour,

Essayez vos comparaisons avec la fonction Instr. Le résultat indique la position du premier caractère de la chaîne cherchée dans la chaîne en référence. Si >0, cela signifie donc que la chaîne cherchée est présente.

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
 
 
Function FiltreMultiCol2(Tbl, colClé1, Clé1, ColResult, Optional colClé2, Optional Clé2, Optional ColTri)
 
  Dim b()
 
        ligne = 1
        If IsMissing(colClé2) Then colClé2 = colClé1: Clé2 = Clé1
        For i = LBound(Tbl) To UBound(Tbl)
           ' If Tbl(i, colClé1) = Clé1 And Tbl(i, colClé2) = Clé2 Then n = n + 1
            If InStr(1, Tbl(i, colClé1), Clé1, vbTextCompare) > 0 And InStr(1, Tbl(i, colClé2), Clé2, vbTextCompare) > 0 Then n = n + 1
        Next i
 
        If n > 0 Then
 
          If IsArray(ColResult) Then
            ReDim b(LBound(Tbl) To n, LBound(ColResult) + 1 To UBound(ColResult) - LBound(ColResult) + 1)
          Else
            ReDim b(LBound(Tbl) To n, 1 To 1)
          End If
 
          For i = LBound(Tbl, 1) To UBound(Tbl, 1)
 
             ' If Tbl(i, colClé1) = Clé1 And Tbl(i, colClé2) = Clé2 Then
              If InStr(1, Tbl(i, colClé1), Clé1, vbTextCompare) > 0 And InStr(1, Tbl(i, colClé2), Clé2, vbTextCompare) > 0 Then
                 If IsArray(ColResult) Then
                    For c = LBound(ColResult) To UBound(ColResult)
                        col = ColResult(c)
                        b(ligne, c + 1) = Tbl(i, col)
                    Next c
                 Else
                    b(ligne, ColResult) = Tbl(i, ColResult)
                 End If
                 ligne = ligne + 1
              End If
         Next i
 
         If Not IsMissing(ColTri) Then Call TriCol(b, LBound(b), UBound(b), ColTri)
            FiltreMultiCol2 = b
         End If
 
End Function

Quelques remarques :

• Déclarez toutes vos variables. Pour vous y inciter, mettez Option Explicit en tête de vos modules. Vous pouvez également le paramétrer par défaut dans votre éditeur VBA. C'est un peu dur au départ, mais au moins vous saurez ce que vous manipulez.
• Indentez vos lignes de code pour le rendre plus lisible et en intercalant des lignes vides pour séparer les différentes parties.
• Accessoirement, ne mettez pas de caractères accentués dans le nom de vos variables.

[idefix007]

Bonjour Eric,

Merci pour votre aide et de m'avoir mis sur la piste de la fonction Instr qui me sera utile pour la suite.
Merci également pour tous les conseils.