Gestion de ronde parking / Insertion de date + copie /intégration de lignes

Bonjour,

Je cherche a créer un VBA pour la gestion des véhicules ventouses d'un parking.

J'ai donc une colonne de dates de ronde avec en face, la plaque de la voiture, sur la place où elle est et l'agent de ronde.

J'ai deux soucis (fichier en PJ)

- Tout d'abord j'ai besoins de créer des lignes pour les dates manquantes (soit les week-ends et jours fériés en général). Pour cela j'ai un code qui fonctionne :

Sub date_creation()

Dim i As Integer

Dim fin As Integer

For i = 2 To 5000

If Cells(i, 1) = "" Then fin = i: Exit For

Next i

For i = 2 To fin

If Cells(i + 1, 1) > Cells(i, 1).Value + 1 Then

Rows(i + 1).Insert

Cells(i + 1, 1) = Cells(i, 1) + 1

End If

Next i

End Sub

- Second problème : J'aimerais que à la place des dates vides (du week end et jours fériés) les lignes de la dernière ronde soit répétées. Exemple :

10/08/2018 3438DZZ 2197

10/08/2018 DF349JC 2061

10/08/2018 DF768CP 2180

10/08/2018 DK597SJ H01

10/08/2018 DV108YJ 2163

10/08/2018 DY454SX 2178

10/08/2018 DZ666LB 2150

10/08/2018 EG098PC 2160

10/08/2018 EH569TV 2148

10/08/2018 EK707WF 1251

10/08/2018 EL759YQ 1191

10/08/2018 EQ895DK 1140

10/08/2018 ET245JA 1126

10/08/2018 EW067RD 1252

11/08/2018

12/08/2018

Il faudrait que lignes du 10 soit répétées pour le 11 et le 12.

Peut-être est il possible de faire un code 2 en 1 ou sinon j'aurais besoin d'une seconde partie de code pour la fin de mon problème.

Etant encore novice en VBA je n'y arrive pas moi même...

Merci !

42parking-vba.xlsx (6.40 Ko)

Bonjour,

J'ai deux soucis (fichier en PJ)

Moi aussi ...

Ton fichier est vide ... et il est vide ...

Effectivement..

Voici la bonne PJ.

Merci et dsl.

Cordialement,

23parking-vba.xlsx (133.16 Ko)

Re,

Merci pour ton fichier ...

Pour te faciliter la vie ... il serait plus efficace que tu saisisses une journée entière ...

Puis il suffirait d'indiquer la date jusqu'à laquelle les rondes doivent être créées ...

Est-ce envisageable ...?

Re,

Ci-joint un premier fichier test ...

En espèrant que cela t'aide

29test-parking.xlsm (34.90 Ko)

Re,

le soucis c'est que c'est que je ne reçois les données que par grosse périodes.

Du coups j'aurais besoin d'un VBA qui copie les lignes de la dernière ronde sur les dates manquante, week et jours fériés (qui n'apparaissent pas de base) :

Exemple :

10/08/2018 1126 ET245JA

10/08/2018 1252 EW067RD

13/08/2018 2197 3438DZZ

13/08/2018 2103 AF777HY

et j'ai besoin qu'il me ressorte

10/08/2018 1126 ET245JA

10/08/2018 1252 EW067RD

11/08/2018 1126 ET245JA

11/08/2018 1252 EW067RD

12/08/2018 1126 ET245JA

12/08/2018 1252 EW067RD

13/08/2018 2197 3438DZZ

13/08/2018 2103 AF777HY

Donc qu'il m'ajoute les dates manquantes et y copie les lignes de la dernière ronde.

De rien

Oui veuillez m'excuser.. j'ai vu seulement à ma relecture tardive que je ne vous avez pas remercié.

Bonjour,

As-tu testé la macro ...???

Bonjour,

Oui cela me copie les lignes de la ronde du 08/04 en boucle jusqu'à la date de fin.

Personnellement, j'aimerais que quand dans la ligne des dates il trouve une date manquante, que le vba ajoute les lignes de la ronde précédentes.

Cordialement,

Bonjour,

Oui cela me copie les lignes de la ronde du 08/04 en boucle jusqu'à la date de fin.

Bonjour,

Pas tout à fait ...

Avant de lancer la macro ...

1. dans la feuille, avoir une journée complète avec toutes les immats ...

2. dans la cellule F1 ... il faut saisir la date de fin du planning ...

3. ensuite, on peut lancer la macro ...

Bonsoir James007, Star-Lord

C'est ce résultat là que tu souhaites obtenir :

Un peu lent à cause du "ReDim Preserve"

Option Explicit
Sub test()
Dim a, e, i As Long, ii As Long, iii As Long, n As Long
Dim dateMin As Long, dateMax As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    With Sheets("Ronde").Range("a1").CurrentRegion
        a = .Value2
        dateMin = a(2, 1): dateMax = a(UBound(a), 1)
        For i = dateMin To dateMax
            dico(i) = Empty
        Next
        For i = 2 To UBound(a, 1)
            If IsEmpty(dico(a(i, 1))) Then
                ReDim w(1 To UBound(a, 2), 1 To 1)
            Else
                w = dico(a(i, 1))
                ReDim Preserve w(1 To UBound(w, 1), 1 To UBound(w, 2) + 1)
            End If
            For ii = 1 To UBound(a, 2)
                w(ii, UBound(w, 2)) = a(i, ii)
            Next
            dico(a(i, 1)) = w
        Next
        For i = 0 To dico.Count - 1
            If IsEmpty(dico.Items()(i)) Then
                ReDim w(1 To UBound(dico.Items()(i - 1), 1), 1 To UBound(dico.Items()(i - 1), 2))
                For ii = 1 To UBound(dico.Items()(i - 1), 2)
                    w(1, ii) = dico.keys()(i)
                Next
                For ii = 2 To UBound(dico.Items()(i - 1), 1)
                    For iii = 1 To UBound(dico.Items()(i - 1), 2)
                        w(ii, iii) = dico.Items()(i - 1)(ii, iii)
                    Next
                Next
                dico.Item(dico.keys()(i)) = w
            End If
        Next
        With .Offset(, .Columns.Count + 3)
            .CurrentRegion.Clear
            .Resize(1) = Array("Date", "N° Véhicule", "N° Place", "Nom de l'agent")
            n = 2
            For Each e In dico.keys
                With .Cells(n, 1).Resize(UBound(dico(e), 2), UBound(dico(e), 1))
                    .Value = Application.Transpose(dico(e))
                    .BorderAround Weight:=xlThin
                End With
                n = n + UBound(dico(e), 2)
            Next
            With .CurrentRegion
                .Rows(1).Interior.ColorIndex = 43
                .HorizontalAlignment = xlCenter
                .BorderAround Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                .VerticalAlignment = xlCenter
                .Font.Name = "Calibri"
                .Font.Size = 10
                .Columns(1).NumberFormat = "m/d/yyyy"
                .Columns.AutoFit
            End With
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour,

Une proposition à étudier.

Réalisé avec Power Query.

VBA est juste utilisé pour l'actualisation.

Cdlt.

16test-parking.xlsm (117.24 Ko)
Rechercher des sujets similaires à "gestion ronde parking insertion date copie integration lignes"