Extraire selon criteres

Bonjour le forum

J'ai un fichier qui me sert à extraire des lignes suivant 1 critere en W1.

J'aimerais extraire avec plusieurs criteres(W1,X1 voire plus).

Comment faut-il modifier dans la macro

merci

20extraitk.xlsm (917.41 Ko)

Bonjour,

en suivant ta logique de programmation

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lg&
  If Not Application.Intersect(Target, Range("W1:X1")) Is Nothing Then
    Application.ScreenUpdating = False
    Lg = Range("b" & Rows.Count).End(xlUp).Row
    Range("a3:a" & Lg).FormulaR1C1 = _
        "=IFERROR(MATCH(R1C23,RC[1]:RC[20],0),0)+IFERROR(MATCH(R1C24,RC[1]:RC[20],0),0)"    'formule

    Range("a2") = "=a3>0"                                      'critère
    Range("a2:u" & Lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("a1:a2"), CopyToRange:=Range("z2:as2"), Unique:=False
    Range("a2:a" & Lg).ClearContents
    'Range("X1:X2").ClearContents
  End If
End Sub
13extraitk.xlsm (925.76 Ko)

Bonjour Steelson, le forum

Merci pour ta réponse, je vais garder ce fichier, mais excuse ma mauvaise explication,

je voulais extraire que les combinaisons qui ont les 2 numéros en commun.

Hors votre fichier extrait aussi bien les combi qui ont le 11 ou le 5 ou les 2.

merci

Bonjour jad73 et Steelson,

un essai voir si cela pourrais correspondre à tes attentes.

Bonne journée.

13extraitk.xlsm (104.27 Ko)

Bonjour bigdady154,steelson,le forum

merci pour la macro mais elle ne prend pas toute la BdD

elle s'arrete à la ligne 451 alors qu'il reste encore la ligne 457 et 462

merci

Bonjour Steelson, le forum

Merci pour ta réponse, je vais garder ce fichier, mais excuse ma mauvaise explication,

je voulais extraire que les combinaisons qui ont les 2 numéros en commun.

Hors votre fichier extrait aussi bien les combi qui ont le 11 ou le 5 ou les 2.

merci

dans ce cas, en respectant ta méthode

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lg&
  If Not Application.Intersect(Target, Range("W1:X1")) Is Nothing Then
    Application.ScreenUpdating = False
    Lg = Range("b" & Rows.Count).End(xlUp).Row
    Range("a3:a" & Lg).FormulaR1C1 = _
        "=IFERROR(MATCH(R1C23,RC[1]:RC[20],0)+MATCH(R1C24,RC[1]:RC[20],0),0)"
    Range("a2") = "=a3>0"                                      'critère
    Range("a2:u" & Lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("a1:a2"), CopyToRange:=Range("z2:as2"), Unique:=False
    Range("a2:a" & Lg).ClearContents
  End If
End Sub
7extraitk.xlsm (919.86 Ko)

tu peux aussi continuer la série pour en avoir un 3ème etc.

MATCH(R1C23,RC[1]:RC[20],0)
+MATCH(R1C24,RC[1]:RC[20],0)
+MATCH(R1C25,RC[1]:RC[20],0)

en encadrant le tout par IFERROR

R1C23 étant la première ligne et 23è colonne (W1) etc.

ps hello bigdaddy154, pas eu le temps de voir ta proposition, j'étais absent toute la journée

Effectivement jad73,

j'ai omis quelque chose voici avec la rectification.

Bonne soirée

14extraitk.xlsm (104.30 Ko)

Bonjour

merci à vous deux, je n'ai que l'embarras du choix

merci

Rechercher des sujets similaires à "extraire criteres"