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

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

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 !

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

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

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

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.

 
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
 

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 !

 
Petite correction des "select"