Date la plus proche

**Ma4dNes** · 03/08/2017, 11h48

Bonjour, j'ai un problème bien tordu à régler et je vais essayer d'être clair.

J'ai deux tableaux excel et il me faudrait un code qui me permette d'écrire le champ id_date lavage du deuxième tableau dans le champ CONT_DATE_LAVAGE du premier.
SAUF QUE :
--> les codes containers doivent correspondre
--> la date à recopier doit être celle qui est la plus proche du champ CONT_DATE_RETOUR et postérieure à celle-ci.

Un même container à effectivement étai lavé plusieurs fois et il y à dont plusieurs lignes pour chaque containers sur les deux tableaux.
(je ne sait pas si tout ceci vous parait clair)

Nom : Sans titre.png
Affichages : 1175
Taille : 69,6 Ko

Nom : Sans titre.png
Affichages : 1175
Taille : 69,6 Ko

Pour l'instant j'avais essayé de trier les données sur la feuil8 par id_conteneur et d'injecter ce petit code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Dim i As Long, i_max As Long, j As Long, j_max As Long, k As Long, Datel As Date
 
i_max = Feuil6.Cells(2, 1).CurrentRegion.Rows.Count
j_max = Feuil8.Cells(2, 1).CurrentRegion.Rows.Count
 
For i = 3 To i_max
    For j = 2 To j_max
        If Feuil6.Cells(i, 4) = Feuil8.Cells(j, 5) And Feuil6.Cells(i, 10) <= Feuil8.Cells(j, 2) Then
            Datel = Feuil8.Cells(j, 2)
            k = j + 1
            If Feuil6.Cells(i, 4) <> Feuil8.Cells(k, 5) Then
                Feuil6.Cells(i, 16) = Datel
            Else
 
                While Feuil6.Cells(i, 4) = Feuil8.Cells(k, 5)
                    If Feuil6.Cells(i, 10) <= Feuil8.Cells(k, 2) And Datel < Feuil8.Cells(k, 2) Then
                        Datel = Feuil8.Cells(k, 2)
                    End If
                Wend
                Feuil6.Cells(i, 16) = Datel
                j = k
            End If
        End If
    Next j
Next i

Qui plante excel (pas de message d'erreur, juste un petit "ne répond plus").
Je précise que je ne suis pas DU TOUT expert en VBA et que je me doute bien que ce code est écrit (voir même pensé) n'importe comment.
Voila cela fait plusieurs jours que je planche là-dessus et je suis coincé.

Ouvert à toutes suggestions.

**riaolle** · 03/08/2017, 15h44

Bonjour,
Idée rapide à développer :
Tu tries (A>Z) les dates, puis tu tries (A>Z) les ID. Tu as donc des blocs avec les ID, et dans chaque bloc d'ID, les dates sont triées du plus ancien au plus récent.
Ensuite, il te suffit pour un ID donné, de trouver la première occurence de cet ID (méthode Application.Match ou Range.Find). A partir de là, tu parcours les dates du bloc de l'ID et tu t'arrêtes à la première date postérieure à la date de référence --> boucle while avec 2 conditions : on a le même ID et on s'arrête dès que la date est postérieure à la date de référence. Tu comprends ?

**Ma4dNes** · 03/08/2017, 15h53

C'est à l'air pas mal. Je vais tester ça. Merci beaucoup riaolle.

**Ma4dNes** · 07/08/2017, 14h53

OK du coup ça à l'air de fonctionner, je vais tester ça cette nuit (+240000 lignes à traiter) on verra le résultat demain matin.
Pour info,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Exec()
Dim i As Long, i_max As Long, cont As String, dater As Date, c As Range, t As Integer
 
i_max = Feuil6.Cells(2, 1).CurrentRegion.Rows.Count
 
For i = 3 To i_max
cont = Feuil6.Cells(i, 4).Value
dater = Feuil6.Cells(i, 10).Value
    With Feuil8.Range("Tableau_BDsuivi_filtre_be.accdb")
        Set c = .Find(cont, LookIn:=xlValues)
        If Not c Is Nothing Then
            t = 0
            Do
                If Feuil8.Cells(c.Row, 2) <> 0 And dater <> 0 Then
                    If Feuil8.Cells(c.Row, 2).Value >= dater Then
                        Feuil6.Cells(i, 16) = Feuil8.Cells(c.Row, 2)
                        t = 1
                    Else
                        Set c = .FindNext(c)
                    End If
                Else
                    t = 1
                End If
            Loop While t = 0
        End If
    End With
    If Feuil6.Cells(i, 16).Value = "" Then
        Feuil6.Cells(i, 16) = "NOPE"
    End If
Next i
End Sub

**Ma4dNes** · 08/08/2017, 11h59

Bon, du coup ça fonctionne très bien jusqu’à la ligne 635 ... après j'ai une erreur d'objet du block with non défini.

Cela fait un moment que je cherche l’erreur mais là je sèche. Une idée ??

**riaolle** · 08/08/2017, 13h16

Ligne 635 ? Peux-tu dire ce qui est écrit sur cette ligne, stp ?

**eriiic** · 08/08/2017, 13h56

Bonjour,

indépendamment de ton message d'erreur, dans ton .find tu dois utiliser le paramètre LookAt.
Là tu recherches un coup avec la valeur exacte, un coup avec 'Contient', selon la dernière utilisation de Ctrl+F ou Ctrl+H.

En Feuil8 ce sont des données avec liaisons ? Ca perturbe peut-être si une mise à jour intervient (?)
eric

**Ma4dNes** · 08/08/2017, 14h28

Envoyé par eriiic

En Feuil8 ce sont des données avec liaisons ? Ca perturbe peut-être si une mise à jour intervient (?)

Je ne pense pas que l'actualisation se fasse automatiquement et se serai "beau" qu'elle intervienne systématiquement à cette ligne. je vais essayer avec lookat.

Envoyé par riaolle

Ligne 635 ? Peux-tu dire ce qui est écrit sur cette ligne, stp ?

J'ai essayé de joindre le fichier mais il est trop gros ... je vais chercher comment exposer le problème de façon claire mais ce qui m’embête c'est que le cas de cette ligne me semble similaire à d'autres lignes précédentes qui n'ont pas causées d'erreur.
Sinon d’après le debug l'erreur se trouverai ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Feuil8.Cells(c.Row, 2) <> 0 And dater <> 0 Then

**Ma4dNes** · 09/08/2017, 10h56

Bon, j'ai légèrement modifié mon code (j'ai trouvé mon erreur) mais maintenant le code se "bloque" à certaines lignes (toujours les mêmes, j'utilise un Debug.Print pour le suivre). Ce qui est étrange c'est que une fois arrivé à ces lignes, si je fais un CTRL+pause et Continuer le code repart comme si de rien n'était sans faire d'erreur ...

Là j'avoue que je n'y comprend rien donc ouvert à toutes suggestions ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Dim i As Long, i_max As Long, cont As String, dater As Date, c As Range, t As Integer
 
i_max = Feuil6.Cells(2, 1).CurrentRegion.Rows.Count
 
For i = 3 To i_max
cont = Feuil6.Cells(i, 4).Value
dater = Feuil6.Cells(i, 10).Value
    With Feuil8.Range("Tableau_BDsuivi_filtre_be.accdb")
        Set c = .Find(cont, LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
            t = 0
            Do
                If Feuil8.Cells(c.Row, 2) <> 0 And dater <> 0 Then
                    If Feuil8.Cells(c.Row, 2).Value >= dater Then
                        Feuil6.Cells(i, 16) = Feuil8.Cells(c.Row, 2)
                        Debug.Print i
                        t = 1
                    Else
                        Set c = .FindNext(c)
                        If c Is Nothing Then
                            t = 1
                        End If
                    End If
                Else
                    t = 1
                End If
            Loop While t = 0
        End If
    End With
    If Feuil6.Cells(i, 16).Value = "" Then
        Feuil6.Cells(i, 16) = "NOPE"
        Debug.Print i
    End If
Next i

Je précise que ces lignes correspondent au cas où il y a moins de lignes dans la deuxième feuille que dans la première pour un même container.

**eriiic** · 09/08/2017, 11h41

Bonjour,

une suggestion : quelle ligne de code ? Quel message d'erreur ?
Incroyable que tu ne puisses penser que ces éléments peuvent être utiles et faire gagner du temps.
Sinon tu as mis LookAt:=xlPart. Ce n'est pas plutôt xlWhole qui t'intéresse ?
eric

**Ma4dNes** · 09/08/2017, 12h00

Envoyé par eriiic

Bonjour,

une suggestion : quelle ligne de code ? Quel message d'erreur ?
Incroyable que tu ne puisses penser que ces éléments peuvent être utiles et faire gagner du temps.
Sinon tu as mis LookAt:=xlPart. Ce n'est pas plutôt xlWhole qui t'intéresse ?
eric

Le code ne plante pas et il n'y a pas de message d'erreur d'où ma perplexité. Il se contente de ne rien faire jusqu’à ce que je le mette en pause et que je le relance.
Sinon le xlPart me paraît préférable car certaine fois la personne qui renseigne le code container fais des petites coquilles (espaces par exemple) mais je me trompe peut être.

Envoyé par Ma4dNes

Bon, j'ai légèrement modifié mon code (j'ai trouvé mon erreur) mais maintenant le code se "bloque" à certaines lignes (toujours les mêmes, j'utilise un Debug.Print pour le suivre). Ce qui est étrange c'est que une fois arrivé à ces lignes, si je fais un CTRL+pause et Continuer le code repart comme si de rien n'était sans faire d'erreur ...

Là j'avoue que je n'y comprend rien donc ouvert à toutes suggestions ...

Ici quand je parle de ligne je fais référence à des lignes de ma page excel et pas à des lignes de mon code. Dsl si je t'ais induit en erreur.

**eriiic** · 09/08/2017, 12h12

Sinon le xlPart me paraît préférable car certaine fois la personne qui renseigne le code container fais des petites coquilles (espaces par exemple) mais je me trompe peut être.

Il vaut mieux ne rien ramener sur une erreur de saisie que de ramener n'importe quoi, par exemple 123 demandé et 1234 trouvé.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Loop While t = 0

sans doute que dans certains cas ta condition de sortie de boucle n'est pas atteinte.
Cette partie me parait douteuse :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
                            Set c = .FindNext(c)
                            If c Is Nothing Then
                                t = 1
                            End If

eric

**Ma4dNes** · 09/08/2017, 12h58

J'essaierai avec le xlWhole pour voir ce qui ressort. Sinon ce petit bout de code est ce qui m'a permis de régler (?) mon problème précédent, l'objet indéfini du block whith qui me plantait cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Feuil8.Cells(c.Row, 2) <> 0 And dater <> 0 Then

.
Après je sais que mon t=0/1 est un peu bancal mais je ne vois pas comment faire autrement. Et de façon plus générale je ne sais plus trop quoi tester. Comment un CTRL+pause et Continué peut il affecter le code ? Quel que chose m’échappe...

**Ma4dNes** · 09/08/2017, 13h07

Ok je viens de faire un test avec xlWole et le code bloque aux même lignes que précédemment plus d'autres lignes. Donc mon problème doit venir du .Find qui doit mouliner dans le vide quand il y a plus de retours container que de lavages container (suis-je clair ?

). Il faudrait que mon code sorte de la boucle Do après avoir traiter le dernier .Find(c) d'un même container. Des idées ?

**RyuAutodidacte** · 09/08/2017, 13h44

Bonjour,

je n'ai pas bcp de temps donc je fais une petite démo pour le principe à partir d'une collection. Les donnée sont à mettre dans un nouveau fichier à partir de A1
En A et B les conteneur ou on récupère la dernière date en D le conteneur équivalent à qui on insère en E les dernières dates

C5006	09/08/17	C5006
C5007	10/08/17	C5007
C5008	11/08/17	C5008
C5009	12/08/17	C5009
C5039	13/08/17	C5039
C5007	14/08/17	C50010
C5039	15/08/17
C50010	16/08/17
C5039	17/08/17
C5009	18/08/17

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Demo()
Dim VA, Cont_dt_Ret As New Collection, V As Range
    VA = Cells(1).CurrentRegion.Value
    On Error Resume Next
    For i = LBound(VA) To UBound(VA)
        Cont_dt_Ret.Add VA(i, 2), CStr(VA(i, 1))
        If Err Then
            If Cont_dt_Ret(VA(i, 1)) < VA(i, 2) Then
                Cont_dt_Ret.Remove VA(i, 1)
                Cont_dt_Ret.Add VA(i, 2), CStr(VA(i, 1))
                Err.Clear
            End If
        End If
    Next
 
    For Each V In Range("D1:D7")
         V.Offset(, 1) = Cont_dt_Ret(V)
        If Err Then Err.Clear
    Next
    On Error GoTo 0
End Sub

code à adapter au contexte

Edit : petite correction du code => gestion d'erreur

**eriiic** · 09/08/2017, 14h00

Après je sais que mon t=0/1 est un peu bancal mais je ne vois pas comment faire autrement. Et de façon plus générale je ne sais plus trop quoi tester.

Regarde l'aide sur range.find
Sur l'exemple avec .findnext tu verras qu'il te manque quelque chose de primordial.
Actuellement si tu ne trouves pas et bien... tu continues de chercher même si tu as atteint la fin

**Ma4dNes** · 09/08/2017, 14h41

Ok j'ai compris le truc. du coup maintenant ça à l'air de fonctionner correctement. Plus qu'à vérifier les résultats obtenus. Merci beaucoup eriiic.

RyuAutodidacte merci de m'avoir conçacrer un peu de temps. Je vais esseyer de décortiquer ton code pour le comprendre (ce sera toujours utile).
Et riaolle merci pour m'avoir mis sur la voie au début.

Pour info

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Dim i As Long, i_max As Long, cont As String, dater As Date, c As Range, t As Integer
 
i_max = Feuil6.Cells(2, 1).CurrentRegion.Rows.Count
 
For i = 3 To i_max
cont = Feuil6.Cells(i, 4).Value
dater = Feuil6.Cells(i, 10).Value
    With Feuil8.Range("Tableau_BDsuivi_filtre_be.accdb")
        Set c = .Find(cont, LookIn:=xlValues, LookAt:=xlWhole)
        firstAddress = c.Address
        If Not c Is Nothing Then
            t = 0
            Do
                If Feuil8.Cells(c.Row, 2) <> 0 And dater <> 0 Then
                    If Feuil8.Cells(c.Row, 2).Value >= dater Then
                        Feuil6.Cells(i, 16) = Feuil8.Cells(c.Row, 2)
                        Debug.Print i
                        t = 1
                    Else
                        Set c = .FindNext(c)
                        If c Is Nothing Then
                            t = 1
                        End If
                    End If
                Else
                    t = 1
                End If
            Loop While t = 0 And c.Address <> firstAddress
        End If
    End With
    If Feuil6.Cells(i, 16).Value = "" Then
        Feuil6.Cells(i, 16) = "NOPE"
        Debug.Print i
    End If
Next i

C'est le And c.Address <> firstAddress qui me manquait.

**Gfacro** · 10/08/2017, 01h27

Vous dites être ouvert à toute proposition aussi voici la mienne :

le faire par formule, cela m'a l'air plus simple.

l'astuce : ajouter dans feuille8 une colonne (éventuellement cachée) - disons la colonnne I
I contient la clé des lignes de nettoyage du container
i2 : "=e2 & " " & texte(B2;"aaaammjj") & 0
remplacer la colonne par les valeurs

trier feuille 8 sur la colonne i décroissante

pour la feuille6, en imaginant que cont_code en colonne D, cont_date_retour est en colonne J et cont_date_lavage en P
p2 : "=si(d2 = index(feuil8!E$2:E$50000;equiv(j2 & " " & texte(j2;"aaaammjj") & 1;-1));index(feuil8!B$2:B$50000;equiv(j2 & " " & texte(j2;"aaaammjj") & 1;-1));"pas de lavage récent")

si le lavage peut avoir lieu la date du jour du retour, enlever les derniers nombres des clés (les soulignés dans les deux formules).

pour l'utilisation, j'imagine que la date de lavage qui suit un retour ne change pas. Vu le nombre de ligne (plus de 240.000, il faut envisager de remplacer les calculs par leur valeur. filtrer la colonne p sur les dates de lavage vide ou qui valent "pas de lavage récent", taper la formule dans la première ligne vide en changeant les 2 en gras par le numéro de la ligne. Tirer la formule jusqu'en bas de la feuille. Enlever les filtres et remplacer la colonne par les valeurs.

ps : désolé, je ne tape jamais une formule du premier coup, il y a donc surement de petites erreurs dans ce que j'ai tapé mais l'idée y est. Je n'ai pas testé.
PS2 : j'ai supposé que les colonnes de date sont au format date, sinon il faut probablement ajouter des cdate
ps3 : envisager éventuellement d'ajouter un sierreur, ou une ligne dans feuil8 avec des zzzz 9999
ps4 : j'ai du mal à imaginer le besoin de garder tous les lavages de tous les containers depuis 2008. envisager d'alleger la feuille des informations inutiles. Par exemple se poser la question de savoir si un container qui est partit, a été lavé et est repartit, s'il est bien nécessaire de conserver les lavages et sorties précédentes. 240.000 lignes, ça va finir par être ingérable s'il n'y a que des ajouts.

ps17 : pour la macro, si elle est longue, envisager de la faire tourner en calcul manuel.
ps24 : les find dans la boucle ne sont pas optimisés. Vu que les tableaux sont triés, il doit être possible de faire des recherches depuis au moins la ligne de la recherche précédente - la réponse de la recherche ne peut pas être avant le résultat de la dernière recherche trouvée.
ps71 : "faudrait que mon code sorte de la boucle ..." : enregistre la cellule à partir de laquelle commence la recherche - ou celle de la première réponse trouvée / ou son numéro de ligne, et teste que la réponse n'y revienne pas ou ne reparte pas à 0.
...

**Ma4dNes** · 10/08/2017, 09h37

Merci, le coup de la formule à l'air intéressant. Je testerai pour voir mais le code fonctionne maintenant ^^.
Par contre j'ai tenu compte de ta remarque sur l'optimisation du .Find et effectivement l'exécution est plus rapide.
Sinon au niveau du nombre de données, 2008 est peut être un peu excessif mais en fait cette feuille sert aussi à suivre les filtres des containers (interchangeables) et le nombre de leurs lavages. Donc un historique très complet est indispensable (l'agroalimentaire ...

). On pourra certainement alléger ces données mais de toutes façon cela n'est pas de mon ressort.