Filtrage complex

[kevin1030]

Bonjour a tous,

J'ai besoin d'aide pour filtrer une collone de caractères afin d'enlever ceux qui contiennent certains caratères d'une autre collone.
Je sais pas si je suis très clair.
Voici un fichier en exemple pour mieux comprendre.

Est ce que quelqu'un aurait une solution?

Merci.

 

[job75]

Re : Filtrage complex

Bonjour kevin1030, bienvenue sur XLD,

On peut utiliser cette fonction VBA (dans Module1) :

Function Epure$(List, Exclure, position&)
Dim t, n&
For Each t In List
  If t <> "" Then
    If IsError(Application.Match(Split(t)(0), Exclure, 0)) Then
      n = n + 1
      If n = position Then Epure = t: Exit Function
    End If
  End If
Next
End Function

Formule en C2, à tirer vers le bas :

=Epure(A$2:A$100;B$2:B$100;LIGNES(C$2:C2))

Les limites (100) sont bien sûr à adapter à chacune des colonnes A et B.

Fichier (1) joint.

A+

 

[job75]

Re : Filtrage complex

Re,

En ajoutant les 3ème et 4ème lignes, la fonction doit être beaucoup plus rapide :

Function Epure$(List, Exclure, position&)
Dim t, n&
List = List.Value
Exclure = Exclure.Value
For Each t In List
  If t <> "" Then
    If IsError(Application.Match(Split(t)(0), Exclure, 0)) Then
      n = n + 1
      If n = position Then Epure = t: Exit Function
    End If
  End If
Next
End Function

Fichier (2).

A+

 

[kevin1030]

Re : Filtrage complex

Merci beaucoup Job75 pour ta rapidité.

Par contre je ne comprend pratiquement rien à ce code VBA.
Sinon c'est excatement ce que je voulais sauf que j'ai oublié de précisé un détail important:

Le filtrage doit se faire sur les 5 premiers caractères des cellules.
Regarde l'exemple dans le fichier pour mieux comprendre.

Merci d'avance

 

[job75]

Re : Filtrage complex

Bonjour kevin1030, le forum,

Alors cette version (3) avec la fonction Left :

Function Epure$(List, Exclure, position&)
Dim t, n&
List = List.Value
Exclure = Exclure.Value
For Each t In List
  If t <> "" Then
    If IsError(Application.Match(Left(t, 5), Exclure, 0)) Then
      n = n + 1
      If n = position Then Epure = t: Exit Function
    End If
  End If
Next
End Function

Mais il y a nettement mieux avec cette version (4) :

Function Epure(List, Exclure)
Dim t, n&, tablo$(9999) 'dimension maximum du tableau, à ajuster
List = List.Value
Exclure = Exclure.Value
For Each t In List
  If t <> "" Then
    If IsError(Application.Match(Left(t, 5), Exclure, 0)) Then
      tablo(n) = t
      n = n + 1
    End If
  End If
Next
Epure = Application.Transpose(tablo)
End Function

La fonction Epure renvoie maintenant une matrice.

On peut la rentrer d'un bloc dans une plage en colonne C en validant matriciellement.

Le calcul est certainement bien plus rapide.

A+

 

[job75]

Re : Filtrage complex

Re,

Allez comme apéritif cette version (5) :

Option Explicit
Option Compare Text 'facultatif, la casse n'est pas prise en compte

Function Epure(List, Exclure)
Dim t1, t2, n&, tablo$(9999) 'dimension maximum du tableau, à ajuster
List = List.Value
Exclure = Exclure.Value
For Each t1 In List
  If t1 <> "" Then
    For Each t2 In Exclure
      If t2 <> "" And t1 Like t2 & "*" Then GoTo 1
    Next
    tablo(n) = t1
    n = n + 1
  End If
1 Next
Epure = Application.Transpose(tablo)
End Function

Ici le nombre de caractères à exclure peut être quelconque.

A+

 

[kevin1030]

Re : Filtrage complex

Merci encore pour ton aide.

Pourais tu (si tu as le temps) m'expliquer un petit peu le code en détail, merci.

Autre chose, j'ai joint la version 3 avec les vrai données que je veux trier.
j'ai essayé de lister d'une autre manière les cellules qui ne m'interessent pas (avec la fonction Vlookup et MID)
Et je me suis aperçu qu'il y avait dans la liste "A exclure" certaines valeures qui n'ont que 3 ou 4 caratères au lieu de 5. Et donc celles-ci ne sont pas triées.
Si tu as une solution, merci d'avance.
Je trouve aussi que le fichier devient vite très lourd, n'y aurais t'il pas une solution plus simple qu'avec ce code?

 

[job75]

Re : Filtrage complex

Re,

Aïe aïe aïe Kevin

Pourais tu (si tu as le temps) m'expliquer un petit peu le code en détail

Le code est très simple, il vaudrait mieux dire ce que vous ne comprenez pas. Si vous ne comprenez rien, travaillez d'abord VBA.

Et je me suis aperçu qu'il y avait dans la liste "A exclure" certaines valeures qui n'ont que 3 ou 4 caratères au lieu de 5. Et donc celles-ci ne sont pas triées.

Et ma version (5), elle compte pour du beurre ? J'avais pourtant offert l'apéro

Je trouve aussi que le fichier devient vite très lourd, n'y aurais t'il pas une solution plus simple qu'avec ce code?

C'est bien pour ça que j'ai proposé une solution matricielle, avec les versions (4) et (5), faudrait suivre le fil...

Ci-joint votre fichier avec la macro de la version (5).

A+

 

[job75]

Re : Filtrage complex

Re encore,

Bon vous avez raison, la solution par fonction n'est probablement pas la plus adaptée ici.

Voici donc la version (6) qui utilise une procédure Sub.

Le code du bouton en Sheet1 :

Private Sub CommandButton1_Click()
Epure Range("A2", [A65536].End(xlUp)), Range("B2", [B65536].End(xlUp))
End Sub

Dans Module1 :

Option Explicit
Option Compare Text 'facultatif, la casse n'est pas prise en compte

Sub Epure(List, Exclure)
Dim t1, t2, n&, tablo$()
List = List.Value
Exclure = Exclure.Value
For Each t1 In List
  If t1 <> "" Then
    For Each t2 In Exclure
      If t2 <> "" And t1 Like t2 & "*" Then GoTo 1
    Next
    ReDim Preserve tablo(n)
    tablo(n) = t1
    n = n + 1
  End If
1 Next
'---restitution---
[C2:C65536].ClearContents
[C2].Resize(n) = Application.Transpose(tablo)
End Sub

A+

 

[job75]

Re : Filtrage complex

Bonjour Kevin, le forum,

Avec cette version (7), je pense qu'on aura fait le tour du problème :

Option Explicit
Option Compare Text 'facultatif, la casse n'est pas prise en compte

Sub Epure()
Dim List, Exclure, d As Object, t1, t2
List = Range("A2", [A65536].End(xlUp))
Exclure = Range("B2", [B65536].End(xlUp))
Set d = CreateObject("Scripting.Dictionary")
For Each t1 In List
  If t1 <> "" Then
    For Each t2 In Exclure
      If t2 <> "" And t1 Like t2 & "*" Then GoTo 1
    Next
    d(t1) = t1
  End If
1 Next
'---restitution---
[C2:C65536].ClearContents
[C2].Resize(d.Count) = Application.Transpose(d.Items)
End Sub

L'objet Scripting.Dictionary donne l'exécution la plus rapide.

Noter que s'il y a des doublons ils sont éliminés.

A+

 

[kevin1030]

Re : Filtrage complex

Bonjour job75,

Merci beaucoup pour ton aide.
Tu me sauve la vie lol
J'ai plus qu'a prendre quelque cours de VBA.

 

[kevin1030]

Re : Filtrage complex

Une dernière chose:
Pouriez vous, si possible, m'expliquer ligne par ligne le code:

Option Explicit
Option Compare Text 'facultatif, la casse n'est pas prise en compte

Sub Epure()
Dim List, Exclure, d As Object, t1, t2
List = Range("A2", [A65536].End(xlUp))
Exclure = Range("B2", [B65536].End(xlUp))
Set d = CreateObject("Scripting.Dictionary")
For Each t1 In List
If t1 <> "" Then
For Each t2 In Exclure
If t2 <> "" And t1 Like t2 & "*" Then GoTo 1
Next
d(t1) = t1
End If
1 Next
'---restitution---
[C2:C65536].ClearContents
[C2].Resize(d.Count) = Application.Transpose(d.Items)
End Sub

 

[job75]

Re : Filtrage complex

Bonjour Kevin,

Il serait plus profitable d'essayer de comprendre avec l'Aide VBA mais bon...

Mettez tout ça dans une feuille de code pour que ce soit lisible :

Sub Epure()
'déclare les varianles : List, Exclure, t1, t2 sont de type Variant
Dim List, Exclure, d As Object, t1, t2
'tableau des valeurs de A2 à la dernière cellule remplie colonne A
List = Range("A2", [A65536].End(xlUp))
'tableau des valeurs de B2 à la dernière cellule remplie colonne B
Exclure = Range("B2", [B65536].End(xlUp))
'crée l'objet d
Set d = CreateObject("Scripting.Dictionary")
'pour chaque item t1 dans le tableau List
For Each t1 In List
'si l'item t1 est <> "" alors...
If t1 <> "" Then
'pour chaque item t2 dans le tableau Exclure
For Each t2 In Exclure
'si t2 <> "" et si t1 commence par t2 ("*" est un caractère générique) alors aller à l'adresse 1
If t2 <> "" And t1 Like t2 & "*" Then GoTo 1
'item t2 suivant
Next
'crée un item de la collection d
d(t1) = t1
'ferme le bloc du 1er If
End If
' adresse 1 => item t1 suivant
1 Next
'---restitution---
'efface les valeurs de la plage C2:C65536
[C2:C65536].ClearContents
'entre les valeurs de d dans la plage commençant en C2 et de hauteur = nombre de valeurs de d
[C2].Resize(d.Count) = Application.Transpose(d.Items)
End Sub

A+