Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Aide Recherche
1523 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Multi Filtrage d'un tableau Excel par macro

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Multi Filtrage d'un tableau Excel par macro

n°2143908
robby98800
Posté le 29-05-2012 à 00:39:54  profilanswer
 

Bonjour,
 
J'ai essayé à plusieurs reprises de m'occuper de cette programmation tout seul.. en vain.
Je vous explique le contexte. Je m'occupe de la maintenance d'un parc éolien et chaque semaine, je reçois un compte rendu excel qui récapitule les défauts qui sont arrivés sur les machines pendant la semaine. La feuille Excel se présente comme suit :  
 
Colonne 1 : Numéro de machine  
Colonne 2 : Libellé de l'erreur (ex : E310, E420 ...)
Colonne 3 : Apparition ou disparition du défaut (APP ou DIS)
 
Je voudrais que la macro soit capable de :  
 
- Prendre en compte seulement les défauts en apparition
- Classer les données dans une autre feuille avec en ligne les machines, et en colonne les défauts pour chacune d'elles.
- Pour chaque machine compter l’occurrence de chaque erreurs
 
Un des problème est que le nombre de défaut par machine changent toutes les semaines, donc la taille des colonnes du tableau que je reçois est variable. En d'autres terme, la macro doit s'adapter à la taille du tableau.
 
Merci à ceux qui prendrons le temps de me répondre !!
 
 
 
 
 
 

mood
Publicité
Posté le 29-05-2012 à 00:39:54  profilanswer
 

n°2144013
JBARBE
Posté le 29-05-2012 à 19:27:44  profilanswer
 

Bonjour,
Je ne sais si cela va vous convenir mais ma macro fonctionne !
 
Il s'agit de mettre dans la "Feuil2" Les N° de machines et les erreurs constatées en "Feuil1" !
 
Voici le fichier !
 
http://cjoint.com/?BEDtBv6eoLx
 
Cliquez sur le bouton " SELECTION ERREUR "
 
et la macro :
 
Sub Copie_Defaut()
Dim j As Integer
Dim i As Integer
Dim k As Integer
 For i = 2 To 20000
 Sheets("Feuil1" ).Select
   Range("A2" ).Select
   If Cells(i, 1) = "" Then
   Range("D:D" ).ClearContents
   Exit Sub
   End If
   If Cells(i, 3).Text = "APP" And Cells(i, 4) = "" Then
   Cells(i, 4) = "X"
  Range(Cells(i, 1), Cells(i, 2)).Copy
   Sheets("Feuil2" ).Select
    Range("A1" ).Select
     ActiveSheet.Paste
     Application.CutCopyMode = False
 For j = 3 To 20000
     If Cells(j, 1) = "" Or Cells(j, 1) = Range("A1" ) Then
     Cells(j, 1) = Range("A1" )
 For k = 2 To 20000
     If Cells(j, k) = "" Then
     Cells(j, k) = Range("B1" )
     Exit For
     Else
     Cells(j, k + 1).Select
     End If
 Next k
  Range("A1:B1" ).ClearContents
    Exit For
     Else
     Cells(j + 1, k).Select
     End If
 Next j
   Else
    Cells(i + 1, 1).Select
   End If
 Next i
End Sub


Message édité par JBARBE le 29-05-2012 à 19:29:39
n°2144029
robby98800
Posté le 30-05-2012 à 08:10:00  profilanswer
 

Bonjour,
 
Merci pour votre réponse, la macro fonctionne en effet mais pour le nombre d'erreur qu'il faut traiter le programme tourne pendant plusieurs minutes !! Il faut peut-être que je parte d'un tableau plutôt qu'une liste. En tout cas merci de votre aide !

n°2144031
robby98800
Posté le 30-05-2012 à 08:19:01  profilanswer
 

Comment je pourrai faire aussi pour classer les même défauts ensemble (faire une sorte de comptage du même défaut)au lieu qu'il n'apparaissent plusieurs fois??

n°2144102
JBARBE
Posté le 30-05-2012 à 22:14:42  profilanswer
 

J'ai ajouté dans la feuil2 une colonne "NOMBRES" qui prend ainsi compte de ta demande !
 
http://cjoint.com/?BEEwopjfICn
 
La macro a été modifiée en conséquence :
 
Sub Copie_Defaut()
Dim j As Integer
Dim i As Integer
Dim k As Integer
 
Application.ScreenUpdating = False
 For i = 2 To 20000
 Sheets("Feuil1" ).Select
   Range("A2" ).Select
   If Cells(i, 1) = "" Then
   Range("D:D" ).ClearContents
   Exit Sub
   End If
   If Cells(i, 3).Text = "APP" And Cells(i, 4) = "" Then
   Cells(i, 4) = "X"
  Range(Cells(i, 1), Cells(i, 2)).Copy
   Sheets("Feuil2" ).Select
    Range("A1" ).Select
     ActiveSheet.Paste
     Application.CutCopyMode = False
 For j = 3 To 2000
     If Cells(j, 1) = "" Or Cells(j, 1) = Range("A1" ) Then
     Cells(j, 1) = Range("A1" )
 For k = 2 To 2000 Step 2
     If Cells(j, k) = Range("B1" ) Then
     Cells(j, k + 1) = Cells(j, k + 1) + 1
     Exit For
     ElseIf Cells(j, k) = "" Then
     Cells(j, k) = Range("B1" )
     Cells(j, k + 1) = 1
     Exit For
     Else
     Cells(j, k + 2).Select
     End If
 Next k
  Range("A1:B1" ).ClearContents
    Exit For
     Else
     Cells(j + 1, k).Select
     End If
 Next j
   Else
    Cells(i + 1, 1).Select
   End If
 Next i
 
 Application.ScreenUpdating = True
End Sub

n°2144119
robby98800
Posté le 31-05-2012 à 00:12:41  profilanswer
 

Merci beaucoup mon ami, ça marche parfaitement bien !
Connaitrais-tu un moyen d'exécuter plus rapidement la procédure ?

n°2144127
oovaveoo
Ivre, il part en tonneau
Posté le 31-05-2012 à 07:56:18  profilanswer
 

Bonjour,
ce que tu veux faire ressemble fortement à de la requête SQL sur base de données.
Tu pourrais travailler dans access ou directement dans ton fichier excel en passant par MSQuery.


---------------
Un avion peut en crasher un autre.
n°2144153
JBARBE
Posté le 31-05-2012 à 11:22:32  profilanswer
 

robby98800 a écrit :

Merci beaucoup mon ami, ça marche parfaitement bien !
Connaitrais-tu un moyen d'exécuter plus rapidement la procédure ?


 
J'ai fait le maximum et la macro a été créée afin d'être le plus simple possible !
 
Néanmoins j'ai fait une petite modif à cette macro que je juge utile que vous tenez compte :
 
http://cjoint.com/?BEFlvROFmQ9
 
Sub Copie_Defaut()
Dim j As Integer
Dim i As Integer
Dim k As Integer
 
Application.ScreenUpdating = False
 For i = 2 To 30000
 Sheets("Feuil1" ).Select
   Range("A2" ).Select
   If Cells(i, 1) = "" Then
   Range("D:D" ).ClearContents
   Exit Sub
   End If
   If Cells(i, 3).Text = "APP" And Cells(i, 4) = "" Then
   Cells(i, 4) = "X"
  Range(Cells(i, 1), Cells(i, 2)).Copy
   Sheets("Feuil2" ).Select
    Range("A1" ).Select
     ActiveSheet.Paste
     Application.CutCopyMode = False
 For j = 3 To 255
     If Cells(j, 1) = "" Or Cells(j, 1) = Range("A1" ) Then
     Cells(j, 1) = Range("A1" )
 For k = 2 To 255 Step 2
     If Cells(j, k) = Range("B1" ) Then
     Cells(j, k + 1) = Cells(j, k + 1) + 1
     Exit For
     ElseIf Cells(j, k) = "" Then
     Cells(j, k) = Range("B1" )
     Cells(j, k + 1) = 1
     Exit For
     Else
     Cells(j, k + 2).Select
     End If
 Next k
  Range("A1:B1" ).ClearContents
    Exit For
     Else
     Cells(j + 1, k).Select
     End If
 Next j
   Else
    Cells(i + 1, 1).Select
   End If
 Next i
 
 Application.ScreenUpdating = True
End Sub
 

n°2144220
robby98800
Posté le 31-05-2012 à 23:16:44  profilanswer
 

Super ! Je viens de refaire un essai avec la nouvelle macro et plusieurs milliers d'erreurs et la procédure ne prend que quelques secondes.  
Merci beaucoup !


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Multi Filtrage d'un tableau Excel par macro

 

Sujets relatifs
Problème d'accès dll VBA/ExcelMacro Excel : remplir les vides avec la valeur de la cellule suivante
Optimiser recherche dans une grosse BDD ExcelFichier Excel "Eurofoot 2012" gratuit à télécharger
Macro Excel -> ajouter un caractère dans une celluleCréer une fonction de recherche sur excel
Attribuer tableau à chaque objet d'une classelancer une application en VBA depuis Excel
Plus de sujets relatifs à : Multi Filtrage d'un tableau Excel par macro



Copyright © 1997-2014 Hardware.fr SARL (Signaler un contenu illicite) / Groupe LDLC / Avis LDLC / LesNumeriques.com