Recherche Modif Etat

NICOALBERT

XLDnaute Occasionnel
Bonjour le Forum ,

Je suis en cours de me réaliser un fichier avec 2 feuilles : une avec les données et la 2ème ou les données recherchées seront stockés.

Ce que je cherche à afficher c'est à chaque changement d'état ( de 0 passe à 1 ou 1 passe à 0) la date soit indiqué en face de la colonne (feuille2).

Je vous joint un fichier exemple qui montre le résultat recherché .

J'ai essayé avec différente formule mais rien à faire :mad:. Je ne sait pas si le mieux et avec formule ou macro car j'ai dans le vrai fichier 107 colonnes et le poid des formules risque de faire planter le fichier ou de l'alourdir .

Cdlt Nicoalbert .
 

Pièces jointes

  • Recherche modif Etat.xlsm
    23.3 KB · Affichages: 14

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Nicoalbert, bonjour le forum,

Une proposition VBA :

VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim NC As Byte 'déclare la variable OS (Onglet Source)

Set OS = Worksheets("Données") 'définit l'onglet source OS
Set OD = Worksheets("Feuil2") 'définit l'onglet destination OD
With OD.Range("C3:XFD12") 'prend en compte la plage C3:CXFD12
    .ClearContents 'efface le contenu d'éventuelles anciennes valeurs
    .NumberFormat = "@" 'mise au format texte
End With 'fin de la prise en compte de la plage C3:CXFD12
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
DL = UBound(TV, 1) 'définit la dernière ligne DL du tableau ds valeurs TV
For COL = 2 To 6 'boucle 1 sur les colonnes 2 à 6 du tableau des valeurs TV
    K = 1: Erase TL: NC = 0 'réinitialise la variable K, efface le tableau TL et réinitialise le nombre de changements NC
    For I = 2 To DL - 1 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (de la seconde à l'avant dernière)
        If TV(I + 1, COL) <> TV(I, COL) Then 'sondition : si la donnée de la ligne en-dessous est différente de la donnée de la boucle
            ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau des lignes (2 lignes, K colonnes)
            TL(1, K) = TV(I, 1) 'récupère la [Date Local Time] de la ligne de la boucle
            TL(2, K) = TV(I + 1, 1) 'récupère la [Date Local Time] de la ligne en-dessous de la ligne de la boucle
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL
            NC = NC + 1 'incrémete le nombre de changements
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    MsgBox NC & " changement(s)  pour la colonne " & COL - 1 & " !" 'message (cette ligne de code peut être supprimée)
    OD.Cells((COL - 1) * 2 + 1, "C").Resize(2, K - 1).Value = TL 'renvoie le tableau TL dans la cellule correspondante
Next COL 'prochaine colonne de la boucle 1
End Sub
 

NICOALBERT

XLDnaute Occasionnel
Bonsoir Robert , le Forum,

Un grand merci pour le temps que tu a pris pour m'aider , la macro fonctionne bien .

Y a t'il moyen de ne pas afficher la date du premier .

Je prend pour exemple ta macro le résultat pour la Col1 est :

Changement 1 Changement 2
Déb >> 2019/04/02 07:31:32.330 Déb >> 2019/04/02 07:32:20.170
Fin >> 2019/04/02 07:31:32.450 Fin >> 2019/04/02 07:32:20.190

Et ce que je cherche c'est :

Changement 1
Déb >> 2019/04/02 07:31:32.450 (passe à 1)
Fin >> 2019/04/02 07:32:20.190 ( Quitte le statut 1 pour passer à 0)

Ensuite repasse à 1

Cdlt Nicoalbert .
 

Robert

XLDnaute Barbatruc
Repose en paix
Re,

Le code modifié :

VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim NC As Byte 'déclare la variable OS (Onglet Source)
Dim TEST As Boolean 'déclare la variable TEST

Set OS = Worksheets("Données") 'définit l'onglet source OS
Set OD = Worksheets("Feuil2") 'définit l'onglet destination OD
With OD.Range("C3:XFD12") 'prend en compte la plage C3:CXFD12
    .ClearContents 'efface le contenu d'éventuelles anciennes valeurs
    .NumberFormat = "@" 'mise au format texte
End With 'fin de la prise en compte de la plage C3:CXFD12
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
DL = UBound(TV, 1) 'définit la dernière ligne DL du tableau ds valeurs TV
For COL = 2 To 6 'boucle 1 sur les colonnes 2 à 6 du tableau des valeurs TV
    K = 1: Erase TL: NC = 0 'réinitialise la variable K, efface le tableau TL et réinitialise le nombre de changements NC
    For I = 2 To DL - 1 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (de la seconde à l'avant dernière)
        If TV(I + 1, COL) <> TV(I, COL) Then 'condition : si la donnée de la ligne en-dessous est différente de la donnée de la boucle
            ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau des lignes (2 lignes, K colonnes)
            NC = NC + 1: TEST = NC Mod 2 'incrémete le nombre de changements, définit la variable TEST en fonction de NC (pair ou impair)
            If TEST = True Then TL(1, K) = TV(I + 1, 1) 'si TEST est [vrai], récupère la [Date Local Time] de la ligne en-dessous de la boucle
            'si TEST est [faux], récupère la [Date Local Time] de la ligne en-dessous de la boucle, incrémente K (ajoute une colonne au tableau des lignes TL
            If TEST = False Then TL(2, K) = TV(I + 1, 1): K = K + 1
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    MsgBox NC & " changement(s)  pour la colonne " & COL - 1 & " !" 'message (cette ligne de code peut être supprimée)
    OD.Cells((COL - 1) * 2 + 1, "C").Resize(2, K - 1).Value = TL 'renvoie le tableau TL dans la cellule correspondante
Next COL 'prochaine colonne de la boucle 1
End Sub
 

NICOALBERT

XLDnaute Occasionnel
Bonsoir Robert , le Forum ,

Je vient d'essayer la macro mais je vient de remarquer 2 bug .

Le premier (col3) si la colonne commence par 1 alors ce sont les date de début et Fin de 0 .

et col4 me met un message d'erreur "erreur d'exécution '1004' : Erreur définie par l'application ou par l'objet "

Cdlt Nicoalbert
 

Pièces jointes

  • Recherche modif Etat-2.xlsm
    34.8 KB · Affichages: 1

Discussions similaires

Statistiques des forums

Discussions
312 160
Messages
2 085 837
Membres
102 999
dernier inscrit
francoisarg56