Résolu Créer un historique

J

julien05

Nouveau membre
Bonjour,

à partir d'un tableau dans lequel je fais apparaitre du texte en cas de panne puis disparaitre quand le probleme est résolu, je souhaiterai créer un historique de ces pannes.

j'arrive à reporter le texte, à enlever les lignes vide mais je n'arrive pas à passer à la ligne suiante. mes données sont systématiquement écraser lorsque mon tableau de départ change.

Voici mon code :

[cpp]Sub historique()


Dim i, a As Single

a = 5
For i = 36 To 57


If Sheets("Feuil1").Cells(i, 1).Value = 1 Then

com = Sheets("Feuil1").Cells(i, 26).Value
datedeb = Sheets("Feuil1").Cells(i, 60).Value
typep = Sheets("Feuil1").Cells(i, 66).Interior.ColorIndex
machine = Sheets("feuil1").Cells(i, 7).Value
ligne = Sheets("feuil1").Cells(i, 68).Value

Else: com = ""
datedeb = ""
typep = xlNone
machine = ""
ligne = ""

End If


Sheets("Feuil2").Cells(a, 3).Value = com
Sheets("Feuil2").Cells(a, 1).Value = datedeb
Sheets("Feuil2").Cells(a, 2).Interior.ColorIndex = typep
Sheets("Feuil2").Cells(a, 5).Value = machine
Sheets("Feuil2").Cells(a, 4).Value = ligne
a = a + 1

Next

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


End Sub
[/cpp]

Quelqu'un peut-il m'aider?
Par avance merci
 
zeb

zeb

Modérateur
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 :
Code: 
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 :
Code: 
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 ?

Code: 
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 :
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'
 
J

julien05

Nouveau membre
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.
 
zeb

zeb

Modérateur
Nan, nan, nan. :non: 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.

¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯\¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
[:flambyx:2]​

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

julien05

Nouveau membre
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.
 
zeb

zeb

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

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

Ligne 9 de mon code on peux lire :
Code: 
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. ;)
 
J

julien05

Nouveau membre
Voila mon idée.

Je pensai utilisé l'algo pour la suppression.

Pour rappel
[cpp]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[/cpp]

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

zeb

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

julien05

Nouveau membre
Meilleure réponse
je pense avoir trouver une solution. en fait le 1 qui sert de condition est tiré d'une formule avec Si (selon qu'une cellule est vide ou non.


J'ai rajouter en ligne 16 un code qui remet à 0 cette cellule. Maintenant vu que ca écrase ma formule il suffit que je me serve des macro qui commande le tableau pour faire apparaitre ce 1.

je teste ca et je te dis si ca marche


[cpp]Sub historique()


Dim i As Long, a As Long

a = Worksheets("Historique (détail)").Range("A65536").End(xlUp).Row + 1


For i = 36 To 57
If Worksheets("Plan atelier").Cells(i, 1).Value = 1 Then
Worksheets("Historique (détail)").Cells(a, 1).Value = Worksheets("Plan atelier").Cells(i, 60).Value
Worksheets("Historique (détail)").Cells(a, 2).Interior.ColorIndex = Worksheets("Plan atelier").Cells(i, 66).Interior.ColorIndex
Worksheets("Historique (détail)").Cells(a, 3).Value = Worksheets("Plan atelier").Cells(i, 26).Value
Worksheets("Historique (détail)").Cells(a, 4).Value = Worksheets("Plan atelier").Cells(i, 68).Value
Worksheets("Historique (détail)").Cells(a, 5).Value = Worksheets("Plan atelier").Cells(i, 7).Value
Worksheets("Plan atelier").Cells(i, 1).Value = 0
a = a + 1
End If

Next

End Sub[/cpp]
 
J

julien05

Nouveau membre
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!!!
 
zeb

zeb

Modérateur
Tiens, ça c'est pour la fine bouche, quand t'auras 5 minutes ;)
Code: 
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
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Dernières actus
Derniers messages publiés
Statistiques globales
Discussions
730 128
Messages
6 717 845
Membres
1 586 373
Dernier membre
https://forum.tomshardwar
Partager cette page
Haut