Gérer un calendrier

[softimen]

Bonjour ,

J'ai besoin de votre aide pour résoudre mon problème s'il vous plait que je trouve un peu compliquée pour moi .
Je commence par vous expliquer mon problème :

j'ai deux fichier sur le mémé classeur excel 2010 .

-le premier fichier :qui contient des données ;trajet , trajet associé et un calendrier qui est saisie automatiquement suite a la saisie des dates de circulation de ce trajet .les dates donc seront remplies dans le calendrier par des "X" pour la période de circulation.

-le deuxième fichier , contient le trajet , le trajet associé avec date d'ouverture de ce trajet .

Je voudrai si c'est possible pour le deuxième fichier ,si pour untrajet ,on a une date d'ouverture précise , alors ,il revient vers le fichier 1 et cherche ce trajet et la date de circulation qui est saisie par "X"(convertir ce X par une date pour peut faire la comparaisson) ;et supprimer dans ce calendrier le "X" qui correspend a cette date.

j’espère que j'ai bien expliqué mon souci .
Je vous joint un fichier pour mieux expliquer mon souci .
J'ai codé un truc mais ça ne fonctionne pas
Dans l'attente de votre aide .Je vous remercie d'avance pour vos effort

 

[vgendron]

Bonjour

J'ai trouver une idée qui permet de supprimer tout le contenu avant d’insérer les nouvelles données , sauf celle la , elle supprime tout les données de la feuille FL2 or j'ai besoin de gardes des donnes dans certaines colonnes comme garde les donnees dans la colonne "L", "V","W".

supprimer toutes les données ==> OK
sauf celle la... ==> laquelle?
garde les donnees dans la colonne "L", "V","W===> OK.. mais comment est on sur que ces données vont toujours correspondre au trajet??
les modifs que tu peux apporter.. est ce que ca peut inclure de rajouter ou supprimer un jour (equivalent à ajouter ou supprimer une ligne dans Recap...)

 

[devimen2]

Bonjour Vgendron ,

Je vous remercie pour votre retour rapide .

Je m'excuse que j'ai pas bien expliqué les choses .
Alors :
Dans l'onglet recap :
****je voudrai avant d’insérer tout les données ( trajet ... date de circulation .... etc) ,( qui seront insérer automatiquement à partir de premier onglet);que avant tout il efface tout les informations du l'onglet recap ; sauf les colonnes suivantes (L,W,AB,AG,AL,AQ) comme ils seront saisie manuellement donc pour éviter les utilisateurs de ré-saisir les données .

*****les modifs que je vais porté dans le premier onglet , ça va pas influencer sur les lignes de recap comme on va faire des modification sur le numéro de trajet ou sa conséquence .

******mais vous avez raison , si on modifie une date dans le premier onglet , ça va effacer ou ajouter des dates dans le deuxième onglet recap;
sauf que j'ai pas une idée pour effacer tout le contenu mais de garder les données ((L,W,AB,AG,AL,AQ) .

J’espère que j'ai bien expliqué mon problème,Dans l'attente de votre aide . Je vous remercie d'avance .
Merci pour votre temps et votre aide sur mon projet ))

 

[vgendron]

Hello

un essai avec ce code à mettre à la place de l'ancien

Sub Recap()
' Macro recap qui permet de remplir le fichier recap fermeture pour ouverture
Application.ScreenUpdating = False
Dim TabRecap() As Variant
Set listeTrajets = CreateObject("Scripting.Dictionary")

Dim nb As Integer, h As Integer, w As Integer, pole As String, datecir As String

Set FL1 = Sheets("Saisie des fermetures")
Set FL2 = Worksheets("Recap Fermeture pour Ouverture")

ann2 = FL1.Range("C1")
ann1 = ann2 - 1

With FL2 'on efface la feuille "Recap" sauf les colonnes L,W,AB,AG,AL,AQ
    TabRecap = .UsedRange.Offset(8, 0).Value
    For i = LBound(TabRecap, 1) To UBound(TabRecap, 1)
        For j = LBound(TabRecap, 2) To UBound(TabRecap, 2)
            If j <> 12 And j <> 23 And j <> 28 And j <> 33 And j <> 38 And j <> 43 Then
                TabRecap(i, j) = ""
            End If
        Next j
    Next i
    .Range("A9").Resize(UBound(TabRecap, 1), UBound(TabRecap, 2)) = TabRecap
End With
'******************************
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
'******************************

'traitement principal
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
        If TabloFL1(NoLig, 30) <> "" Then 's'il y a une date de fermeture
            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)
                ListeJours(i) = .Cells(6, ele.Column)
                i = i + 1
            Next ele
            inserer2 'appel de la macro "Inserer2"
        End If
    Next Trajet
End With

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

Application.ScreenUpdating = True
End Sub

 

[devimen2]

Vgendron

Merci beaucoup , c'est ce que je voudrais faire exactement

Je suis vraiment très reconnaissante pour votre aide pour mon projet .
Vous etes fort en VBA ;

 

[devimen2]

Vgendron , voila , excusez moi que j'ai pas bien expliqué les choses ,

 

[vgendron]

Bah vraiment désolé.. mais meme avec ce fichier.. je ne vois pas ce qui plante...
si je fais un double clic (= la meme chose que si je met ou change le contenu d'une cellule) n"importe ou.. j'ai bien la date en A
si je fais la meme chose en X, la date arrive en Z et A..
et pas de bug...

 

[devimen2]

ah désolée mais sur ma version j'ai toujours le bug ,
voila ce qui m'affiche .
Merci pour votre temps et votre aide ... je suis debutante en vba et je travaille seul sur le projet

 

[vgendron]

Essaie ceci

Private Sub Worksheet_Change(ByVal Target As Range)

Dim aRow As Integer
If Target.Cells.Count > 1 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

Edité pour déplacer la commande Application.EnableEvents = false

 

[vgendron]

et ceci pour éviter de mettre des dates dans les lignes 1 à 7

Private Sub Worksheet_Change(ByVal Target As Range)

Dim aRow As Integer
If Target.Cells.Count > 1 Or Target.Row < 8 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

à noter qu'avec ce code.. une fois qu'une date est mise en colonne A.. tu ne peux plus la supprimer....
enfin. si.. tu peux.. en selectionnant plusieurs cellules de la colonne et en faisant Sup...

 

[devimen2]

Bonjour ,
Merci ça marche trés bien .Vous m'avez sauvéz comme d'habitude
et si je veux supprimer , est ce que il y' a une solution s'il vous plait ?

 

[vgendron]

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

 

[devimen2]

vraiment , Vgendron vous êtes très fort en vba (*****) , vous m'avez beaucoup aidé sur l'avancement de mon projet .


En faite si c'est possible s'il vous plait , j'ai besoin de modifié votre macro dupliquer massive de la ligne mais j'ai pas réussi

cette macro permet de dupliquer la ligne en faisant de copier coller en commençant de numéro de trajet de début jusqu'a numéro de trajet de fin
'
je voudrai modifié ma macro si c'est possible , en dupliquant la ligne tout en gardant le mémé esprit mais en rentrant dans un message box , les différents numéro de trajet separées par ";"

je vous joint un fichier avec capture d'ecran .

le resultat souhaité se trouve dans la feuille saisie des fermeture )))

Et je remercie beaucoup pour votre aide ))

Sub dupliquermassive()
Dim lignes As Integer
Dim debut As Integer

If ActiveCell.Column <> 2 Then Exit Sub 'si on clique ailleurs qu'en colonne B, on sort

debut = ActiveCell 'InputBox("N° DE DEBUT ")
fin = InputBox("Demande de fermeture massive : Du trajet n° " & debut & Chr(10) & "Au trajet n° ")
If fin = "" Then
MsgBox ("saisie vide, saissisez un n°")
Exit Sub
ElseIf debut > fin Then
MsgBox (" Erreur de saisie, le n° doit être supérieur à " & debut)
Exit Sub
Else: fin = CInt(fin)
End If

Rep = MsgBox("Confirmation de la fermeture massive destrajetsn° " & debut & " jusqu'au n° " & fin, vbYesNo)
If Rep = 7 Then Exit Sub
For i = ActiveCell.Row To ActiveCell.Row + (fin - debut) - 1
With ActiveCell.EntireRow
.Offset(1, 0).Insert Shift:=xlDown
.Copy Destination:=.Offset(1, 0)
End With
Next i
For i = ActiveCell.Row To ActiveCell.Row + (fin - debut) - 1
ActiveSheet.Range("B" & i + 1) = debut + i - ActiveCell.Row + 1
Next i

End Sub

 

[vgendron]

Bonjour

Je ne comprend pas bien ce que tu souhaites faire avec les différents numéros de trajets séparés par un ";"

ceci??

Sub dupliquermassive()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim lignes As Integer
Dim debut As Integer


If ActiveCell.Column <> 2 Then Exit Sub 'si on clique ailleurs qu'en colonne B, on sort

debut = ActiveCell 'InputBox("N° DE DEBUT ")
fin = InputBox("Demande de fermeture massive : Du trajet n° " & debut & Chr(10) & "Aux trajets n° ")
If fin = "" Then
    MsgBox ("saisie vide, saissisez un n°")
    Exit Sub
Else
    Listetrajet = Split(fin, ";")
End If

Rep = MsgBox("Confirmation de la fermeture massive des trajets n° " & debut & " jusqu'au n° " & fin, vbYesNo)
If Rep = 7 Then Exit Sub
j = UBound(Listetrajet)
For i = ActiveCell.Row To ActiveCell.Row + UBound(Listetrajet, 1)
   
    With ActiveCell
        .EntireRow.Offset(1, 0).Insert Shift:=xlDown
        .EntireRow.Copy Destination:=.EntireRow.Offset(1, 0)
        .Offset(1, 0) = CInt(Listetrajet(j))
        j = j - 1
       
    End With
Next i
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[devimen2]

Vgendron

Merci beaucoup , vous avez tout compris , c'est exactement , ce que j'ai voudrai faire et ça fonctionne très bien .

pour répondre a votre question , pou le ";" ce pour séparer entre les différents numéros de trajet à rentrer comme exemple 8560 ; 8563;8565;8568

Comment faire pour ajouter un message box pour forcer l'utilisateur de rentre les numéros de trajet séparées par "; " , comme exemple si on rentre les numéros de trajets séparées par "/" ça bug .
j'ai ajouté cette instruction mais ça fonctionne pas.
If listetrajet <> ";" Then
MsgBox ("saisie ";"comme separateur entre les trajets )
Exit Sub

 

[vgendron]

à adapter pour le message

Sub dupliquermassive()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim lignes As Integer
Dim debut As Integer


If ActiveCell.Column <> 2 Then Exit Sub 'si on clique ailleurs qu'en colonne B, on sort

debut = ActiveCell 'InputBox("N° DE DEBUT ")
fin = InputBox("Demande de fermeture massive : Du trajet n° " & debut & Chr(10) & "Aux trajets n° ")
If fin = "" Then
    MsgBox ("saisie vide, saissisez un n°")
    Exit Sub
Else
    For i = 1 To Len(fin)
        If Not ((Mid(fin, i, 1) >= 0) And (Mid(fin, i, 1) <= 9) Or (Mid(fin, i, 1) = ";")) Then
            MsgBox ("saisie incorrecte, ce caractère n'est pas autorisé: " & Chr(10) & Mid(fin, i, 1))
            Exit Sub
        End If
    Next i
End If
    Listetrajet = Split(fin, ";")


Rep = MsgBox("Confirmation de la fermeture massive des trajets n° " & debut & " jusqu'au n° " & fin, vbYesNo)
If Rep = 7 Then Exit Sub
j = UBound(Listetrajet)
For i = ActiveCell.Row To ActiveCell.Row + UBound(Listetrajet, 1)
   
    With ActiveCell
        .EntireRow.Offset(1, 0).Insert Shift:=xlDown
        .EntireRow.Copy Destination:=.EntireRow.Offset(1, 0)
        .Offset(1, 0) = CInt(Listetrajet(j))
        j = j - 1
       
    End With
Next i
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub