Discussion :

[Ma4dNes]

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)



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]

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]

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

[Ma4dNes]

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]

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]

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

[Gfacro]

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 ?

J'avoue ne pas avoir tout lu avec attention. Depuis le départ, je ne comprend pas bien l'utilité de cette recherche puisque les données des deux feuilles sont triées sur le numéro de contenaire si j'ai bien compris.
si vous voulez faire des aller-retours sur toutes les lignes de votre contenaire, il vous suffit de garder en mémoire la première ligne de votre contenaire et parcourir les lignes suivantes jusqu'à ce que cet identifiant change.
Si vous n'avez pas besoin de faire des allers-retours, il suffit de vérifier le numéro du contenaire de la ligne suivante (ou précédente selon votre besoin).

et ce pour les deux feuilles éventuellement. Un principe de synchronisation entre les deux feuilles.

[RyuAutodidacte]

Bonsoir,

PS :
- Pour le Timer on peut utiliser directement VBA
- Sachant que ton nombre de lignes dépasse les 65536 (qui est la limite à Application.Index) j'ai fait une fonction permettant d'avoir le même type de résultat, comme cela on copie seulement sur les colonnes incriminées

Comme le sujet n'est pas mis en résolu, voilà une démo2 comme je l'ai fait un peu en aveugle n'étant pas sur d'avoir toutes les informations mais pour le principe tout y est normalement :

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Sub Demo2()
Dim F8, F6, Coll As New Collection, L$, D(), Lig(), i&, j&, Ligne, N As Integer, dater, T!
 
    F8 = Feuil8.UsedRange.Value
    F6 = Feuil6.UsedRange.Value
 
    T = Timer
 
        On Error Resume Next
        For i = 2 To UBound(F8)
            Coll.Add i, CStr(F8(i, 5))
            If Err Then
                L = Coll(F8(i, 5))
                Coll.Remove F8(i, 5):       Coll.Add L & " " & i, CStr(F8(i, 5))
            End If
            Err.Clear
        Next
 
        For i = 3 To UBound(F6)
            Coll (F6(i, 4))
            If Err.Number = 0 Then
                a = Split(Coll(F6(i, 4)), " ")
                For j = 0 To UBound(a)
                    If CDate(F8(a(j), 2)) >= CDate(F6(i, 10)) Then
                        N = N + 1:       ReDim Preserve D(1 To N):       ReDim Preserve Lig(1 To N)
                        D(N) = CLng(CDate(F8(a(j), 2))):       Lig(N) = a(j)
                    End If
                Next
                dater = CDate(Application.Min(D))
                If Not Err Then
                    Ligne = CLng(Lig(Application.Match(CLng(dater), D, 0)))
                    F6(i, 16) = dater
                    F6(i, 17) = F8(Ligne, 3)
                    F6(i, 13) = F8(Ligne, 4)
                End If
            End If
            If F6(i, 16) = "" Then
                F6(i, 16) = "NO"
                F6(i, 17) = "NO"
                F6(i, 13) = "NO"
            End If
            Err.Clear:    N = 0:    dater = "":    Ligne = "":    Erase D, Lig
        Next
        On Error GoTo 0
 
    Application.ScreenUpdating = False
        Res = Index_Tab(F6, 3, 13):    Feuil6.Cells(3, 13).Resize(UBound(Res), UBound(Res, 2)) = Res:    Erase Res
        Res = Index_Tab(F6, 3, 16, 17):    Feuil6.Cells(3, 16).Resize(UBound(Res), UBound(Res, 2)) = Res:    Erase Res
    Application.ScreenUpdating = True
 
    MsgBox "Temps d'execution : " & Format(Timer - T, "0.000 s")
End Sub
 
Function Index_Tab(VA As Variant, Entete As Byte, ParamArray Arr()) 'Les paramètres : 1- Variable tableau | 2- Entete (afin de la supprimer ou pas) Í 3-Array (colonne voulu de la variable tableau, ex : 4, 7, 9)
Dim VB(), i&, j&
    ReDim VB(1 To UBound(VA) - Entete + 1, 1 To UBound(Arr) + 1)
    For i = Entete To UBound(VA)
        For j = 1 To UBound(Arr) + 1:    VB(i - Entete + 1, j) = VA(i, Arr(j - 1)):    Next
    Next
    Index_Tab = VB
End Function

Voilà

Edit : je remet le bon code, j'ai pas copier le bon

[RyuAutodidacte]

Bonjour Ma4dNes,

J'ai testé ton code, et j'ai remarqué 2 choses qui vont peut-être poser problème si tu as le même résultat dans ton fichier.
Pour cela j'ai créé un fichier avec de fausses donné seulement sur les colonnes incriminées.
La première chose, c'est que lorsque ton code est terminé il ajoute une ligne après la dernière ligne, en rajoutant des Nope.
La deuxième chose, sur :

Code :

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

                    If Feuil8.Cells(c.Row, 2).Value >= dater Then

La valeur égal n'est pas forcément pris en compte :
Si on a 17/08/17 et 18/08/17 en Feuil8 et 17/08/17 pour dater
Le résultat pourra être 18/08/17 et non 17/08/17

PS : dans mon code j'ai utilisé dater pour le résultat en Feuil6 sur Cells(i, 16)

As tu testé mon code. Qu'en est-il ?

[Ma4dNes]

OK, 5.31s
Je ne sais pas trop si je suis en joisse ou dégoutté
Plus qu'à décortiquer ton code pour le comprendre. Du coup merci beaucoup. je clorai la discussion quand les résultats auront étés validés.