perte des donnes lors de lancement de macro

[devimen2]

Bonjour

J'ai besoin de votre aide pour résoudre mon problème s'il vous plait .

J'ai une macro Recap1 qui permet d’insérer des données automatiquement dans une feuille FL2 à partir des informations qui se trouvent dans une feuille FL1 .

Cette Macro Recap1 que un membre de ce groupe m'a déja aidé "@ vgendron " avant que je le remercie beaucoup déja .

'lien vers la poste pour vous rappelez de la conversation et la macro recap 'https://www.excel-downloads.com/threads/gérer-un-calendrier.20023887/page-2

la macro recap1 fonctionne sauf que j'ai 3 soucis

"la macro se trouve dans le module macro_recap_vgendron" dans le fichier ci-joint

En fait , j'ai 3 Soucis :

• le premier souci: l'insertion des dates automatique, dans la colonne C du deuxieme onglet , qui se rempli a partir des "X" dans le calendrier de premier onglet, "insertion des dates oui mais pas les correctes dates"

• le deuxième souci : quand je lance ma macro recap1 , j'ai une perte des formules qui se trouvent dans les colonnes N; O; P ;Q; R .

• le troixieme souci ; j'ai insertion des données oui , mais pas toutes , je pense a cause de cette instruction :

With FL1
LastCol = .Cells(6, .Columns.Count).End(xlToLeft).MergeArea.Offset(0, 1).Column - 1
LastLine = .UsedRange.Rows.Count
TabloFL1 = .Range("B8:AG" & LastLine).Value
On Error Resume Next 'permet de bypasser les erreurs qui apparaissent lorsqu'on va vouloir créer un trajet déjà existant
For i = LBound(TabloFL1, 1) To UBound(TabloFL1, 1)
'sur la colonne B, on récupère les numéros de trajet UNIQUE avec leur position dans le tableau "TabloFL1"
listeTrajets.Add TabloFL1(i, 1), i 'créer une liste sans doublon des trajets de la colonne B = 1ere colonne du tablo
Next i
End With

En fait ; je voudrai insérer toutes les donnes mais sans doublons c'est a dire avant d'inserer ,il faut verifier

' verifier sur la feuille 1 si les données de colonnes B ; C; S ;T; U ;X ;AC ;AD se repetents sur autre ligne alors inserer qu'une seule ligne dans l'autre feuille recap .

J'espere que j'ai bien expliquer les choses .

'j'ai expliquer par des commentaires dans le code recap les soucis .

Je vous remercie d'avance.

 

[Bebere]

bonjour
si bien compris
un code pour les dates,partie après traitement principal jusqu'au end with de witl fl1
code inutile si le calendrier était fait avec formules,en plus serait évolutif au fil des ans

    With FL1
        For Each Trajet In listeTrajets.keys    'sur chaque Trajet de la colonne B
            NoLig = listeTrajets(Trajet)    'on récupère la position dans la table

            k = WorksheetFunction.CountA(.Range("AH" & NoLig + 7).Resize(1, LastCol - 33))    'compte le nombre de jours dans le calendrier à traiter
            ReDim ListeJours(1 To k)    'redimensionne le tableau qui contient les k DateCir à traiter
            i = 1
            'on remplit le tableau avec les DateCir
            For Each ele In .Range("AH" & NoLig + 7).Resize(1, LastCol - 33).SpecialCells(xlTextValues)
                Select Case ele.Column
                Case Is < 65
                    If .Cells(6, ele.Column) = 1 Then mois = .Cells(3, ele.Column) * 1
                    an = 2017
                    mois = 12
                   
                Case 64 To 96
                 mois = 1
                 an = 2018
                
                Case 95 To 124
                 mois = 2
                 an = 2018
                
                 Case 124 To 156
                 mois = 3
                 an = 2018
                   
                Case 155 To 186
                 mois = 4
                 an = 2018
                  
                Case 185 To 216
                 mois = 5
                 an = 2018
                   
                Case 216 To 247
                 mois = 6
                 an = 2018
                   
                 Case 247 To 278
                 mois = 7
                 an = 2018
                   
                Case 277 To 308
                 mois = 8
                 an = 2018
                
                Case 308 To 338
                 mois = 9
                 an = 2018
                   
                Case 388 To 369
                 mois = 10
                 an = 2018
                   
                 Case 369 To 400
                 mois = 11
                 an = 2018
                   
                Case 399
                 mois = 12
                 an = 2018

                End Select



                ListeJours(i) = DateSerial(an, mois, .Cells(6, ele.Column))
                i = i + 1
            Next ele
            inserer2    'appel de la macro "Inserer2"

        Next Trajet
    End With

 

[devimen2]

Bonjour Berbers,

Merci beaucoup pour votre retour .

Pour le problème d'insertion des dates ;c'est bon , maintenant il insére les trajets avec les dates de circulations corrects ,sauf que il efface toujours les formules qui existent dans les colonnes N,O,P,Q,R et on plus ils affiche des données bizarres comme la photo ci-joint.
je sais pas le problème vient d’où ?
Merci pour votre aide .

 

[devimen2]

ReBonjour,

J'ai pu résoudre le problème de suppression des formules par modification 'une ligne de code
'TabRecap = .UsedRange.Offset(8, 0).Value , je l'ai modifié par TabRecap = .UsedRange.Offset(8, 0).Formula .

Il me reste maintenat le souci qu'il inséré pas tout les données
En fait ; je voudrai s'il vous plait insérer toutes les donnes mais sans doublons c'est a dire avant d’insérer dans la feuille 2 ,

' verifier sur la feuille 1 si les données de colonnes B ; C; S ;T; U ;X ;AC ;AD se repetents sur autre ligne alors inserer qu'une seule ligne dans l'autre feuille recap .

Merci d'avance

 

[vgendron]

Hello !!

J'ai pu résoudre le problème de suppression des formules par modification 'une ligne de code
'TabRecap = .UsedRange.Offset(8, 0).Value , je l'ai modifié par TabRecap = .UsedRange.Offset(8, 0).Formula .

bah du coup. tu m'en apprends une belle !! :-D
je regarde pour le reste

 

[vgendron]

Pour le problème de date.. tu as modifié la ligne 6 qui ne contient plus de date, mais juste les jours...
Du coup, j'ai remis. mais il me semble qu'il y avait aussi des dates dans la ligne 7..?? je ne sais plus, et pas retesté toutes les macros..
hello @Bebere j'ai pas vérifié si ton code prenait en compte les années bisextiles... foutu mois de février.. :-D
mais comme tu dis. si le calendrier était déjà avec des dates.. ce serait plus simple et je suis totalement d'accord.. c'est pour ca que j'ai modifié et utilisé le format personalisé pour ne voir que le numéro du jour

pour les doublons.. manquait un test dans la création du dictionnaire de trajet

For i = LBound(TabloFL1, 1) To UBound(TabloFL1, 1)
        'sur la colonne B, on récupère les numéros de trajet UNIQUE avec leur position dans le tableau "TabloFL1"
        If Not ListeTrajets.exists(TabloFL1(i, 1)) And TabloFL1(i, 1) <> "" Then
            ListeTrajets.Add TabloFL1(i, 1), i 'créer une liste sans doublon des trajets de la colonne B = 1ere colonne du tablo
        End If
    Next i

 

[devimen2]

Bonjour Vgendron ;

Merci beaucoup pour votre retour .De retour sur la macro recap et toujours sur le meme projet .

Pour une fois c'est moi que vous ai appris un truc ".formula". (pas de suppression des formules "ok ")

Donc , pour la macro recap , je suis parti sur celle que j'ai développé et qui se trouve dans le module dev_imen en intégrant deux blocs de votre code comme c’était plus facile pour moi avec tous les changements a effectuer ( comme je maitrise ma macro , c'est plus facile pour adapter les nouvelles modifications ):

pour les deux Blocs que j'ai adapté :

• 'bloc1 qui permet de supprimer toutes les données de l'onglet "recap fermetures pour ouverture" en gardant que certaines données (ok)

• 'bloc 2 qui permet de renvoyer date NOK)

1. si il y a une date dans S alors renvoyer dans Y sans effacer S
   
2. si il y a une date dans AD alors renvoyer dans Y et S sans effacer AD

sauf qu'il y a un problème lorsqu'il renvoie la date , en effet il renvoie la date mais il perd le format à chaque fois :
c'est a dire :
Si on rentre des données dans une nouvelle ligne en choisissant le pole a à partir d'une liste déroulante qui se trouve dans la colonne "X" et qu'on rentre une date dans la colonne "AE" du premier onglet, en passant au deuxième onglet, on relance dev_imen, la format de date change malgré que j'ai bien mis pour les colonnes concernées "format date"
comme exemple : voir la capture
par exemple toto1 : on a une date dans pole C (onglet 1), il renvoie la date dans S et Y (onglet 2) mais sans tenir compte du format "date"
et toto2 : on a une date dans pole a(onglet 1), il renvoie date dans pole b(onglet 2) mais pas au format date .

J'arrive pas à détecter le problème , il y' a a chaque fois des soucis avec cette macro .
A chaque fois que je résous un problème, il en arrive un autre

Dans l'attente de votre aide et retour

 

[vgendron]

sauf qu'il y a un problème lorsqu'il renvoie la date , en effet il renvoie la date mais il perd le format à chaque fois :

Pour commencer....
et si tu mettais ENFIN des DATES dans la ligne 6 !
en AH6 = Date(C1-1;12,1) ==> permet de mettre le 01 déc de l'année qui précède celle saisie en C1
puis AI6 = AH6+1 jusqu'au bout à droite

il te suffit de changer l'année en C1 et TOUT le calendrier se met à jour ==> plus besoin du code de bebere et plus besoin de faire attention aux années bisextiles
et ensuite.. les codes écrits devraient fonctionner...

maintenant que tu as écris des dates en ligne 6 ==> pour ne VOIR que le numéro du jour ==> utiliser le format personnalisé "jj"
en ligne 4
AH4=AH6 et tirer à droite jusqu'au bout
et format personnalisé pour ne VOIR que le NOM du jour "jjj"

 

[vgendron]

et pourquoi repostes tu un fichier dans lequel il n'y a pas les dernières modifications?

 

[devimen2]

merci pour votre retour

en fait , c'est mon responsable qui m'a demandé de ne pas touché au calendrier comme tous les macros fonctionnent surtout celle de remplissage calendrier , tout les macros sur le premier onglet fonctionnent grâce a votre aide surtout pour la duplication que vous m'avez aidé avant .
Merci à berber mais j'ai pas utilisé son code , je me suis basé seulement sur mon code et ton code pour extraire les deux blocs .
Donc , comme je vous ai dit , j'arrive pas a detecter le probleme de date , je pense que ça arrive de cette instruction .

Comme , une fois j'ai un bug qui m'a dit probleme de Range
With FL2
FinFeuille = .Range("B" & .Rows.Count).End(xlUp).Row

For nb = 9 To FinFeuille
If .Range("S" & nb) <> "" Then .Range("Y" & nb) = .Range("S" & nb)
If .Range("AD" & nb) <> "" Then
.Range("S" & nb) = .Range("AD" & nb)
.Range("Y" & nb) = .Range("AD" & nb)

End If
Next nb

End With

Je reste à votre disposition pour plus d'information et je m'excuse si mes questions sont pas trés claires , je suis nouvelle en dev VBA et c'est mon premier projet .votre aide m'a beaucoup aidé

 

[vgendron]

bon.. soit..
suffit de remettre le format date

With FL2
    FinFeuille = .Range("B" & .Rows.Count).End(xlUp).Row
    For nb = 9 To FinFeuille
        If .Range("S" & nb) <> "" Then .Range("Y" & nb) = Format(.Range("S" & nb), "dd/mm/yyyy")
        If .Range("AD" & nb) <> "" Then
            .Range("S" & nb) = Format(.Range("AD" & nb), "dd/mm/yyyy")
            .Range("Y" & nb) = Format(.Range("AD" & nb), "dd/mm/yyyy")
        End If
    Next nb
End With

 

[devimen2]

Bonjour Vgendron ,

Merci beaucoup .

Ca m'a aidé à résoudre mon problème . Merciiiiii . (Recap ok )

Sauf que j'ai un problème de renvoyer date de mise à jour (onglet1) .

En faite , j'ai une macro qui permet de renvoyer automatiquement la date d'aujourd'hui des que il y'a une modification sur une ligne (onglet 1).Ca fonctionne trés bien oui mais si je clique sur bouton remplissage automatique calendrier ou bien séparer origine/destination (onglet1); ça me renvoie une date sur toutes les lignes et écrase les autres dates .
J'arrive pas a détecter le problème .
Je pense comme remplissage calendrier et séparer origine /Destination permet de balayer toutes les lignes ; donc il renvoie la date automatique .
Y'a il une solution pour ça .
1-si on modifie une ligne alors il renvoie la date .(ok)
2-si on rentre une ligne alors il renvoie la date.(ok)
3-si on rentre plusieurs lignes et on clique sur bouton séparer origine/destination et remplissage automatique , ça renvoie la date que sur les lignes concernés et garde les anciennes dates .
J’espère que j'ai bien expliqué mon problème. "j'ai colorer la colonne A pour vous expliquer mieux le probleme"

Algorithme :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim aRow As Integer
If Target.Cells.Count > 1 Or Target.Row < 8 Or Target = "" Then Exit Sub
Application.EnableEvents = False
With ActiveSheet
Fin = .UsedRange.Rows.Count
If Not Intersect(Target, Range("X8:X" & Fin)) Is Nothing Then
.Range("Z" & Target.Row) = Date
End If
.Range("A" & Target.Row) = Date
End With
Application.EnableEvents = True
End Sub


En vous remerciant d'avance pour votre effort .

 

[vgendron]

Hello
pour le calendrier.. si le chef ne veut pas que l'on touche aux dates juste parce qu'il ne veut pas avoir a refaire la ligne 3,
ce code s'en charge

Sub UpdateCalendrier()
Application.EnableEvents = False
'permet d'updater la ligne 3 de la feuille Saisie des fermetures
With Sheets("Saisie des fermetures")
    Deb = 34
    Lastcol = .Cells(6, .Columns.Count).End(xlToLeft).MergeArea.Offset(0, 1).Column - 1
    .Cells(3, Deb).Resize(1, Lastcol).UnMerge
    .Cells(3, Deb).Resize(1, Lastcol).ClearContents
    While Deb <= Lastcol
       
        Fin = Deb
        While Month(.Cells(6, Fin)) = Month(.Cells(6, Deb))
            Fin = Fin + 1
        Wend
        .Cells(3, Deb).Resize(1, Fin - Deb).Merge
        .Cells(3, Deb) = Format(.Cells(6, Deb), "mmmm")
         
        Deb = Fin
    Wend
    .Cells(3, 34).Resize(1, Lastcol - 33).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
End With
Application.EnableEvents = True
End Sub

et il suffit de l'appeler dès que l'année en C1 est modifiée...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim aRow As Integer
If Not Intersect(Target, Range("C1")) Is Nothing Then
    UpdateCalendrier
End If

With ActiveSheet
    Fin = .UsedRange.Rows.Count
    If Target.Cells.Count > 1 Or Target.Row < 8 Or Target = "" Or Target.Row > Fin Then Exit Sub

    Application.EnableEvents = False
    If Not Intersect(Target, Range("X8:X" & Fin)) Is Nothing Then
        .Range("Z" & Target.Row) = Date
    End If
    .Range("A" & Target.Row) = Date
End With
Application.EnableEvents = True
End Sub

 

[vgendron]

Pour ton problème de dates qui se remplissent partout..
NE PAS OUBLIER qu'il y a une macro évènementielle CHANGE
c'est elle qui se déclenche à chaque fois qu'une cellule est modifiée...
il faut donc l'inhiber le temps de la macro: avec Application.enableevents=false

Sub OrigineDestination()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim x As String, FL1 As Worksheet, NoLig As Long

Set FL1 = ActiveSheet

With FL1
    For NoLig = 8 To .UsedRange.Rows.Count
        MOT1MOT2 = .Cells(NoLig, "E")
        i = InStr(MOT1MOT2, "/")
        If i = 0 Then
            .Cells(NoLig, "F") = ""
        Else
            .Cells(NoLig, "F") = Left(MOT1MOT2, i - 1)
            .Cells(NoLig, "G") = Mid(MOT1MOT2, i + 1)
        End If
    Next NoLig
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

et idem sur l'autre macro.. que je n'ai pas cherchée...

 

[vgendron]

remarque et conseil (que je pense t'avoir déjà fait)
il va falloir revoir ta façon d'écrire les codes..
exemple de la macro SNCF:
elle est incompréhensible juste à cause de l'indentation du code:
il y a parfois 4 5 ou 6 lignes vides entre deux lignes de code.. quel intérêt?? on est obligé de faire du scroll souris pour avancer dans le code
l'INDENTATION !! = décalage par tabulation des instructions par bloc


ce code

Function verif(o As String, k() As String)
r = False
For j = 1 To UBound(k)
    If (o Like k(j)) Then
        r = True
        Exit For
    Else
        r = False
    End If
Next j
verif = r
End Function

est quand meme BEAUCOUP PLUS LISIBLE et donc compréhensible que celui ci

Function verif(o As String, k() As String)
r = False
For j = 1 To UBound(k)
If (o Like k(j)) Then
r = True
Exit For
Else
r = False
End If
Next j
verif = r
End Function

j'avais déjà rectifé quelques macros. mais je vois que tu persistes à garder les anciennes.. pourquoi?