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
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
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
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
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
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