Créer un historique

Ouh que c'est pas beau !

Salut Julien.

De la très belle écriture pour certaines choses, du vraiment pas beau pour d'autres. Ton algo pour la suppression est pour le moins surprenant, mais intelligent. Mais je cherche encore pourquoi tu remplis des lignes vides pour les supprimer  

Je ne parlerai que des trucs pas bien, ne t'en vexe pas  

1° Où sont les déclarations des variables ? La ligne 4 n'est pas suffisante.
a est un numéro de colonne et doit être déclaré en entier, pas en réel.

2° A la place de Sheets, utilise Worksheets. Là, je chipote.

3° Indente correctement ton code.

4° En 1980, on utilisait While / Wend. De nos jours, utilise Do .. Loop

Ça fait :

Option Explicit
 
Sub historique()
 
	Dim i As Long, a As Long             
	Dim com, datedeb, typep, machine, ligne
 
	a = 5
	For i = 36 To 57
	    If Worksheets("Feuil1" ).Cells(i, 1).Value = 1 Then
	        com     = Worksheets("Feuil1" ).Cells(i, 26).Value
	        datedeb = Worksheets("Feuil1" ).Cells(i, 60).Value
	        typep   = Worksheets("Feuil1" ).Cells(i, 66).Interior.ColorIndex
	        machine = Worksheets("feuil1" ).Cells(i, 7).Value
	        ligne   = Worksheets("feuil1" ).Cells(i, 68).Value
 
	        Worksheets("Feuil2" ).Cells(a, 3).Value = com
	        Worksheets("Feuil2" ).Cells(a, 1).Value = datedeb
	        Worksheets("Feuil2" ).Cells(a, 2).Interior.ColorIndex = typep
	        Worksheets("Feuil2" ).Cells(a, 5).Value = machine
	        Worksheets("Feuil2" ).Cells(a, 4).Value = ligne
	        a = a + 1
	    End If
	Next
 
End Sub

Encore plus concis :

Option Explicit
 
Sub historique()
 
	Dim i As Long, a As Long             
 
	a = 5
	For i = 36 To 57
	    If Worksheets("Feuil1" ).Cells(i, 1).Value = 1 Then
	        Worksheets("Feuil2" ).Cells(a, 1).Value = Worksheets("Feuil1" ).Cells(i, 60).Value
	        Worksheets("Feuil2" ).Cells(a, 2).Interior.ColorIndex = Worksheets("Feuil1" ).Cells(i, 66).Interior.ColorIndex
	        Worksheets("Feuil2" ).Cells(a, 3).Value = Worksheets("Feuil1" ).Cells(i, 26).Value
	        Worksheets("Feuil2" ).Cells(a, 4).Value = Worksheets("feuil1" ).Cells(i, 68).Value
	        Worksheets("Feuil2" ).Cells(a, 5).Value = Worksheets("feuil1" ).Cells(i, 7).Value
	        a = a + 1
	    End If
	Next
End Sub

Le problème, c'est que tu remets ton historique à partir de la ligne 5, systématiquement. Il faudrait recommencer à la suite, non ?

Option Explicit
 
Sub historique()
 
	Dim i As Long, a As Long
 
	a = Worksheets("feuil2" ).Range("A65536" ).End(xlUp).Row + 1
	For i = 36 To 57
	    If Worksheets("Feuil1" ).Cells(i, 1).Value = 1 Then
	        Worksheets("Feuil2" ).Cells(a, 1).Value = Worksheets("Feuil1" ).Cells(i, 60).Value
	        Worksheets("Feuil2" ).Cells(a, 2).Interior.ColorIndex = Worksheets("Feuil1" ).Cells(i, 66).Interior.ColorIndex
	        Worksheets("Feuil2" ).Cells(a, 3).Value = Worksheets("Feuil1" ).Cells(i, 26).Value
	        Worksheets("Feuil2" ).Cells(a, 4).Value = Worksheets("feuil1" ).Cells(i, 68).Value
	        Worksheets("Feuil2" ).Cells(a, 5).Value = Worksheets("feuil1" ).Cells(i, 7).Value
	        a = a + 1
	    End If
	Next
End Sub

Cela t'aide-t-il ?
Si oui, étudie ce code :

Option Explicit
 
Sub historique()
	Dim cell_panne As Range
	Dim cell_histo As Range
 
	Set cell_panne = Worksheets("feuil2").Columns(1).Cells(65536).End(xlUp).Offset(1)
	For Each cell_histo In Worksheets("Feuil1" ).Range("A36:A57")
	    If cell_histo.Value = 1 Then
					cell_panne.Offset(0, 0).Value               = cell_histo.Offset(0, 59).Value
					cell_panne.Offset(0, 1).Interior.ColorIndex = cell_histo.Offset(0, 65).Interior.ColorIndex
					cell_panne.Offset(0, 2).Value               = cell_histo.Offset(0, 25).Value
					cell_panne.Offset(0, 3).Value               = cell_histo.Offset(0, 67).Value
					cell_panne.Offset(0, 4).Value               = cell_histo.Offset(0,  6).Value
	        Set cell_panne = cell_panne.Offset(1)
	    End If
	Next
End Sub

-----------
EDIT: Ligne 8, il manquait le mot Each. Désol'

Salut Zeb,

ta réponse est super, ca marche beaucoup mieux que mes codes (comme je connais pas grand chose j'essai des solutions dérvivées).

Par contre j'ai du mal avec ce le dernier code c'est bien au dela de mes compétences.

Pourrais-je te demander une autre petite chose?

Comment faire pour ne pas recopier une ligne si elle n'a pas été effacée? je m'explique: si d'autres pannes surviennent mais qu'une autre est toujours existante, si je valide mes pannes la macro me recopie une nouvelle fois cette panne.

Nan, nan, nan.   Il n'y a rien qui ne soit au delà de tes compétences, pour peu que tu les élèves un peu. Et c'est justement le but de ce dernier code : te faire progresser.

Pour l'instant et la suite, je vais t'aider à faire ton boulot. Ma récompense ne devrait être qu'un "merci" ? Sache que je ne m'en contenterai pas. Il me faudra aussi être convaincu de t'avoir appris quelque chose.

C'est la rançon exigée ici.



_________________
NB. Je suis un tortionnaire : pour t'encourager, je repartirai du dernier code.

J'étais justement en train de vouloir tester ton dernier code mais il y a un problème ligne 8.

Pour ce qui est de mon autre problème je réfléchis à quelques solutions et il est vrai que c'est mon boulot. j'aurai due te répondre qu'une fois une solution trouvé. j'y ai pensé mais le message était déjà envoyé. dsl

je m'y remet de suite.

EDIT:
Quel est le problème de la ligne 8 ?
Incompression de ta part ou bug ?
Ligne 8, il manquait le mot Each. Désol'

-------------

Ligne 9 de mon code on peux lire :

If cell_histo.Value = 1 Then

C'est la condition pour faire la copie.

Or tu voudrais y ajouter : <<si elle n'a pas été effacée>>
Je propose plutôt : <<si elle n'a pas déjà dans l'historique>>.

Qu'en penses-tu ?
Il faut donc déterminer de com, datedeb, machine et ligne quels sont les champs discriminants. Puis on recherche si la ligne est présente dans l'histo. Si oui, on ne fait rien, si non, on copie.

A la lumière de ces éléments, as-tu une idée de comment faire ?

-------------

Pour me faire plaisir, renomme ta feuil1 en Panne(*) et ta feuille 2 en Historique(*).

(*) Ou autre, à ton choix, pourvu que ce soit pertinent.  

Voila mon idée.

Je pensai utilisé l'algo pour la suppression.

Pour rappel

b = Sheets("feuil2").Range("A65536").End(xlUp).Row

 
a = 5

While a <= b

 
If Sheets("feuil2").Cells(a, 1) = "" Then

Sheets("feuil2").Rows(a).Delete Shift:=xlUp

b = b - 1

 
Else

 
a = a + 1

 
End If

 
Wend

Je pense remplacer le while wend pour etre plus a la page.

Mais le hic c'est de remplacer "" (ligne 6) par la ou les lignes déja existantes.

On se répond l'un avant l'autre  
Relis tout et dis moi que tu es prêt.

Meilleure réponse sélectionnée par julien05.

J'ai résolu le problème. Je te remercie encore de ton aide

J'avais lu beaucoup de commentaires sur des forum et du coup pas mal des tiennes. ca m'a fait plaisir que tu m'aide. tu as amélioré ma compréhension.

Encore merci!!!

Euh, non, c'est toi, qui mérite la meilleure réponse  

Meilleure réponse sélectionnée par zeb.

Tiens, ça c'est pour la fine bouche, quand t'auras 5 minutes  

Option Explicit
 
Sub historique()
    Dim f_panne     As Worksheet ' // Feuille
    Dim f_histo     As Worksheet ' // Feuille
    Dim c_panne     As Range     ' // Cellule
    Dim c_histo     As Range     ' // Cellule
    Dim c_histo_der As Range     ' // Cellule
    Dim com         As Variant   ' // N'importe quoi
    Dim dat         As Variant   ' // N'importe quoi
    Dim found       As Boolean   ' // Booléen
 
    Set f_panne = Worksheets("liste des pannes")
    Set f_histo = Worksheets("historique des pannes")
 
    Set c_histo_der = f_histo.Columns(1).Cells(65536).End(xlUp).Offset(1)
 
    For Each c_panne In f_panne.Range("A36:A57")
        If c_panne.Value = 1 Then
            ' // Supposons que les critères soient com et dat
            com = c_panne.Offset(0, 25).Value
            dat = c_panne.Offset(0, 59).Value
 
            ' // recherchons la ligne (com, dat) dans "liste des pannes"
            found = False
            For Each c_histo In f_histo.Range(f_histo.Range("A5"), c_histo_der)
                If c_histo.Offset(0, 2) = com And _
                   c_histo.Offset(0, 0) = dat _
                Then
                    ' // On a trouvé !!!!!
                    found = True
                    ' // Pas besoin d'aller au bout
                    Exit For
                End If
            Next
 
            ' // Si on n'a pas trouvé, on fait la copie
            If Not found Then
                c_histo.Offset(0, 0).Value = c_panne.Offset(0, 59).Value
                c_histo.Offset(0, 1).Interior.ColorIndex = c_panne.Offset(0, 65).Interior.ColorIndex
                c_histo.Offset(0, 2).Value = c_panne.Offset(0, 25).Value
                c_histo.Offset(0, 3).Value = c_panne.Offset(0, 67).Value
                c_histo.Offset(0, 4).Value = c_panne.Offset(0, 6).Value
 
                Set c_histo_der = c_histo_der.Offset(1)
            End If
        End If
    Next
End Sub