Filtre critère

Bonjour messieurs , très très ancien programmeur PHP/PEARL/JAVA (plus de 20 que je n'ai pas écrit de ligne de code) j'ai bcq de mal sur un script qui est a deux doigt de me rendre chèvre.

J'ai essayer de le documenter au max , mon souci est que je n'arrive pas a utiliser une variable pour le critère de filtre , j'ai mis des message box avant après mon appel de filtre , ma variable est bien reconnu , mais impossible de la faire utiliser par le filtre ?????

Autre petit souci , j'ai le fameux message qui me demande de choisir si je veux conserver mes donner a la fermeture de mon fichier mypath et n'arrive pas à m'en débarrasser

Et un troisième , j'ouvre un fichier cvs et l'enregistre en TXT pour pouvoir le convertir en UTF8 si je pouvais directement l'importer en CSV en UTF8 ce serais top

E gros l'utilisateur va chercher un fichier de résultat , je l'ouvre j'applique un filtre , je copie la ligne filtré et j'inverse colonne/ligne puis je colle le tous dans une nouvelle feuille (le top serais que je puisse en même temps coller une formule de calcule a coté )

Sub SelectionFichierResultat_Global()
Dim mypath
Dim Nparti As String
Nparti = Workbooks("Chgt19.xlsm").Sheets("RecupResult").Range("D1").Value
'Nparti = NomParticipant (variable venant d'un nommage de cellule classeur)
' ouvre une boite de dialogue demandant à l'utilisateur d'aller chercher le
' fichier qu'il souhaite et mais le chemin du fichier dans la variable mypath
   mypath = Application.GetOpenFilename
' On sort de la fonction si aucun choix de fichier
   If mypath = False Then Exit Sub
' On Ouvre le fichier
       Workbooks.OpenText Filename:= _
        mypath _
        , Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, Tab:=True, TrailingMinusNumbers:=True
' On applique les filtres avec critères en variable
MsgBox Nparti
Range("A1").CurrentRegion.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$P$8").AutoFilter Field:=5, Criteria1:=Nparti
    MsgBox Nparti
' On selectionne le résultat et on copie
    Range("A1").CurrentRegion.Select
   Application.CutCopyMode = False
    Selection.Copy
'On referme le fichier sans enregistrer les changements
   ActiveWindow.Close savechanges:=False
'On ajoute une nouvelle Feuille à la fin du Classeur en la nommant
    Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Traitement"
'On colle le résultat
   Range("A1").CurrentRegion.Select
         ActiveSheet.PasteSpecial Format:="Texte Unicode", Link:=False, _
        DisplayAsIcon:=False, NoHTMLFormatting:=True
'On copie le résultat
    Range("A1").CurrentRegion.Select
    Application.CutCopyMode = False
    Selection.Copy
'On colle résultat dans la feuille recupresultat en inversant colonne/ligne
    Sheets("RecupResult").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

'On met en forme
    Selection.Columns.AutoFit
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
'On supprime la feuille de traitement
Application.DisplayAlerts = False
    Sheets("Traitement").Delete
Application.DisplayAlerts = True

End Sub

Énorme merci a ceux qui me lirons , je suis a bout .... je viens d'y passer 5 H sasn trouver de solution ....

N hésitez pas a me donner des conseils sur la façon de coder , je suis vraiment rouiller lol donc mon code doit vraiment pas être optimisé.

N'étant pas un monsieur, je laisserai mes "collègues" hommes vous répondre

Cindy

toutes mes excuses m'dame Cindy .

Je bloque toujours la dessus

' On applique les filtres avec critères en variable
MsgBox Nparti
Range("A1").CurrentRegion.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$P$8").AutoFilter Field:=5, Criteria1:=Nparti
    MsgBox Nparti

Ma variable Nparti n'est pas utilisédans mon filtre alors que la variable est ok avant et après en testant au msgbox

Bonjour,

Quand on travaille sur plusieurs classeurs, il est fortement conseillé d'utiliser des variables objets Workbook. Comme tu n'as pas posté de fichier, voici une ébauche de code utilisant deux variables Workbook :

    Dim ClsSource As Workbook
    Dim ClsCible As Workbook
    Dim Plage As Range
    Dim mypath
    Dim Nparti As String

    Set ClsCible = ThisWorkbook

    Nparti = ClsCible.Sheets("RecupResult").Range("D1").Value
    mypath = Application.GetOpenFilename

   If mypath = False Then Exit Sub

    Set ClsSource = Workbooks.OpenText(Filename:=mypath, Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Tab:=True, TrailingMinusNumbers:=True)

    'On ajoute une nouvelle Feuille à la fin du Classeur en la nommant
    ClsCible.Sheets.Add(, Worksheets(Worksheets.Count)).Name = "Traitement"

    With ClsSource.Worksheets(1)

        Set Plage = .Range(.Cells(1, 1), _
                    .Cells(.Cells.Find("*", .[A1], -4123, , _
                    1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                    2, 2).Column))

        Plage.AutoFilter
        Plage.AutoFilter 5, Nparti

        .AutoFilter.Range.EntireRow.Copy ClsCible.Worksheets("Traitement").Range("A1")

    End With

    'On referme le fichier sans enregistrer les changements
   ClsSource.Close False
   'suite ...

Déjà mille merci pour ton aide , je me rend compte que je ne faisait pas du tous comme il faut.

Je ne savais pas qu'on pouvais mettre son fichier , je le met donc ici .

Il me faut juste 2 ligne de mon fichier CSV la 1er et celle qui contient l'adresse email du participant puis je dois inverser colonne et ligne pour pouvoir les traiter par comparaison a des réponse puis je note juste ou faux.

Je ne sais pas si c'st une bonne idée mais je pense plutôt faire une boucle pour trouver mes deux lignes et les copier plutôt qu'un filtre ?

Merci encore pour ton aide

Voici une autre piste, avec une requête sur le fichier .csv !

Le code utilisé et plus bas, le classeur test :

Le code liée au bouton sur la feuille RecupResult où se trouve l'adresse mail. Attention, les adresses sont orthographiées de façon différente entre la cellule D1 de la feuille "RecupResult" du classeur "Chg220119.xlsm" et du .csv :

Sub FichierTexte()

    Dim Fe As Worksheet
    Dim Plage As Range
    Dim T
    Dim mypath
    Dim Nparti As String
    Dim I As Integer

    mypath = Application.GetOpenFilename
    If mypath = False Then Exit Sub

    Nparti = ThisWorkbook.Sheets("RecupResult").Range("D1").Value

    'si la feuille n'existe pas, elle est créée sinon, vidée
    On Error Resume Next
    Set Fe = Worksheets("Traitement")

    If Err.Number <> 0 Then

        Set Fe = Sheets.Add(, Worksheets(Worksheets.Count))
        Fe.Name = "Traitement"

    Else

        Fe.Cells.Clear

    End If

    On Error GoTo 0 'suppression du gestionnaire d'erreur

    'applique une requête sur le fichier
    With Fe.QueryTables.Add("TEXT;" & mypath, Fe.Range("A1"))

        .TextFileSemicolonDelimiter = True
        .Refresh 'exécute la requête
        .Delete 'supprime la connexion au fichier texte

    End With

    'défini la plage et applique le filtre avec copie du résultat
    'sur la feuille "Feuil1" atterntion, elle doit exister !
    With Fe

        Set Plage = .Range(.Cells(1, 1), _
                    .Cells(.Cells.Find("*", .[A1], -4123, , _
                    1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                    2, 2).Column))

        Plage.AutoFilter 5, Nparti

        .AutoFilter.Range.EntireRow.Copy Worksheets("Feuil1").Range("A1")

    End With

    'les valeurs sont passées à un tableau, la feuille est vidée et les valeurs sont
    'placées en colonne A pour les entêtes et B pour les valeurs
    With Worksheets("Feuil1")

        .Activate

        Set Plage = .Range(.Cells(1, 1), _
                    .Cells(.Cells.Find("*", .[A1], -4123, , _
                    1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                    2, 2).Column))

        T = Plage
        .Cells.Clear

        For I = 1 To UBound(T, 2)

            .Cells(I, 1).Value = T(1, I)
            .Cells(I, 2).Value = T(2, I)

        Next I

    End With

    Application.DisplayAlerts = False
    Sheets("Traitement").Delete
    Application.DisplayAlerts = True

End Sub

Le classeur test :

Merci beaucoup ca marche parfaitement , c'est exactement ce que je voulais en beaucoup plus rapide .

Par contre je perd ma conversion UTF8 du coup je suis tous accentué .

Au sujet de l'adresse mail ou petite erreur de ma part

Pour la première piste , je n'arrive pas à la faire fonctionner j'ai erreur de compilation, fonction ou variable attendu (désolé vraiment débutant en codage microsoft)

Sub FichierTexteentest()
 Dim ClsSource As Workbook
    Dim ClsCible As Workbook
    Dim Plage As Range
    Dim mypath
    Dim Nparti As String

    Set ClsCible = ThisWorkbook

    Nparti = ClsCible.Sheets("RecupResult").Range("D1").Value
    mypath = Application.GetOpenFilename

   If mypath = False Then Exit Sub

    Set ClsSource = Workbooks.OpenText(Filename:=mypath, Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Tab:=True, TrailingMinusNumbers:=True)

    'On ajoute une nouvelle Feuille à la fin du Classeur en la nommant
    ClsCible.Sheets.Add(, Worksheets(Worksheets.Count)).Name = "Traitement"

    With ClsSource.Worksheets(1)

        Set Plage = .Range(.Cells(1, 1), _
                    .Cells(.Cells.Find("*", .[A1], -4123, , _
                    1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                    2, 2).Column))

        Plage.AutoFilter
        Plage.AutoFilter 5, Nparti

        .AutoFilter.Range.EntireRow.Copy ClsCible.Worksheets("Traitement").Range("A1")

    End With

    'On referme le fichier sans enregistrer les changements
   ClsSource.Close False
   'suite ...

End Sub

encore merci pour ton aide

Essais de cette façon :

Workbooks.OpenText Filename:=mypath, Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Tab:=True, TrailingMinusNumbers:=True
Set ClsSource = ActiveWorkbook 'puisqu'il vient de s'ouvrir

Essais de cette façon :

Workbooks.OpenText Filename:=mypath, Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Tab:=True, TrailingMinusNumbers:=True
Set ClsSource = ActiveWorkbook 'puisqu'il vient de s'ouvrir

Fonctionne parfaitement maintenant merci merci

la deuxième solution est ultra rapide maque juste l'utf8 .

le fichier va comporter environ 300/400 colonne et une 100 de lignes, penses tu que ma la première solution ira ? si oui je continue comme ca.

Ps merci pour ta facon de coder , ca me permer d'apprendre

Pour la deuxième piste j'ai simplemnt rajouté

         .TextFilePlatform = 65001

à la fonction QueryTables , ca marche nikel maintenant .

Du coup je me retrouve avec deux solutions qui marche nikel

Du coup ca marche aussi en important directement le CSV parfait

Toute petite chose encore sur la deuxième solution que je pense utiliser , ma feuille etait pré-enregistré avec un script sur la 3eme colonne , mais du coup après le clear de cellule tous disparais lol , est 'il possible de générer une troisième colonne avec ce code dedans

=NB.SI.ENS(FReponses!I:I;B1;FReponses!C:C;A1)

dans le code ci dessous

 With Worksheets("Feuil1")

        .Activate

        Set Plage = .Range(.Cells(1, 1), _
                    .Cells(.Cells.Find("*", .[A1], -4123, , _
                    1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                    2, 2).Column))

        T = Plage
        .Cells.Clear

        For I = 1 To UBound(T, 2)

            .Cells(I, 1).Value = T(1, I)
            .Cells(I, 2).Value = T(2, I)

        Next I

    End With

j'ai beaucoup de mal à comprendre les attributions de Plage ainsi que la recréation du tableau, mon cerveau fume merci encore

Je teste ca mais ca ne passe pas

       .Cells(I, 3).Formula = "=NB.SI.ENS(FReponses!I:I;B"&I&";FReponses!C:C;A"&I&")"

il faudrait que les formules s’applique a partir de la ligne 7 sur la troisième colonne

Tu peux remplacer :

.Cells.Clear

par :

.Columns("A:B").Clear

de façon à pouvoir garder tes formules en colonne C

Sinon, pour les formules c'est "FormulaLocal" si tu la rentre en Français :

.Cells(I, 3).FormulaLocal = "=NB.SI.ENS(FReponses!I:I;B" & I & ";FReponses!C:C;A" & I & ")"

ou "Formula" en Anglais :

.Cells(I, 3).Formula = "=COUNTIFS(FReponses!I:I,B" & I & ",FReponses!C:C,A" & I & ")"

Merci beaucoup Theze je vien de comprendre mon erreur , j'avais corrigé en Formula lol me suis fait avoir par l'espace nécessaire avant et après le & maintenant je sais

 .Cells(I, 3).FormulaLocal = "=NB.SI.ENS(FReponses!I:I;B"&I&";FReponses!C:C;A"&I&")"

ne marche pas j'aurais pus y rester un moment sans ton aide merci

Content de pouvoir t'aider et bonne continuation

Encore mille merci Theze

de 1 pour ton aide précieuse

de 2 pour ta sympathie et

de 3 pour ta façon de coder/expliquer au top pour comprendre

Du coup j'ai pris gout au VBA grâce à toi , me voila parti dans l'apprentissage ... moi qui pensais juste faire ce traitement de fichier puis basta .

je vrais reprendre après plus de 20 ans d’arrêt

Tu vas y prendre goût, concevoir et construire un outil c'est à mon sens très gratifiant

Rechercher des sujets similaires à "filtre critere"