Comparaison de dates

**tod22** · 20/07/2012, 11h44

Bonjour,
J'ai récemment pris un code sur ce forum et modifié les champs de comparaison.
J'ai deux feuillets dans le même classeur, un feuillet B_Livraison et un feuillet Factures.
J'ai rentré dans ces deux feuillets des dates au format date type *14/03/2001.
Je souhaite donc comparer les dates du feuillet B_Livraison et Factures. Mais le code que j'ai n'associe les BL aux Factures qu'en fonction du nom du Fournisseur.

Voila mon 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
26
27
28
29
30
31
32
33
34
35
 
Sub rapprochement_Factures_BL()
 
 
 
nb_factures = Worksheets("Factures").Range("A65536").End(xlUp).Row    ' on compte le nombre de lignes'
nb_BL = Worksheets("B_Livraison").Range("A65536").End(xlUp).Row
 
For ligne = 2 To nb_factures
'on lit le fournisseur'
Fournisseur = Trim(Worksheets("Factures").Cells(ligne, 2).Value)
'on lit la date'
Dat = FormatDateTime(Worksheets("Factures").Cells(ligne, 3).Value)
Dat2 = FormatDateTime(Worksheets("B_Livraison").Cells(ligne, 3).Value)
 With Worksheets("B_Livraison").Range("B2:B" & CStr(nb_BL))
    Set cellule = .Find(What:=Fournisseur, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
          If Not cellule Is Nothing Then
              prem_occurence = cellule.Row
                Do
                    If Worksheets("B_Livraison").Cells(cellule.Row, 2).Value = Fournisseur And Dat2 = Dat Then
                     ' on a trouvé , on indique'
                       Worksheets("B_Livraison").Cells(cellule.Row, 7).Value = " Rapprochement OK"
                       Worksheets("B_Livraison").Cells(cellule.Row, 8).Value = Worksheets("Factures").Cells(ligne, 1).Value
                       Worksheets("Factures").Cells(ligne, 7).Value = " Rapprochement OK"
                       Worksheets("Factures").Cells(ligne, 8).Value = Worksheets("B_Livraison").Cells(cellule.Row, 1).Value
                    End If
                  Set cellule = .FindNext(cellule)
               Loop While Not cellule Is Nothing And cellule.Row <> prem_occurence
            End If
 End With
 
Next
 
 
End Sub

Dans l'attente d'une âme charitable qui pourra m'aider,
Cordialement, Antoine.

**Daniel.C** · 20/07/2012, 14h55

Bonjour,

Essaie comme ceci :

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
Sub rapprochement_Factures_BL()
 
 
 
nb_factures = Worksheets("Factures").Range("A65536").End(xlUp).Row    ' on compte le nombre de lignes'
nb_BL = Worksheets("B_Livraison").Range("A65536").End(xlUp).Row
 
For ligne = 2 To nb_factures
'on lit la date'
Dat = FormatDateTime(Worksheets("Factures").Cells(ligne, 3).Value)
Dat2 = FormatDateTime(Worksheets("B_Livraison").Cells(ligne, 3).Value)
 With Worksheets("B_Livraison").Range("B2:B" & CStr(nb_BL))
    If Worksheets("B_Livraison").Cells(cellule.Row, 2).Value = Fournisseur And Dat2 = Dat Then
     ' on a trouvé , on indique'
       Worksheets("B_Livraison").Cells(cellule.Row, 7).Value = " Rapprochement OK"
       Worksheets("B_Livraison").Cells(cellule.Row, 8).Value = Worksheets("Factures").Cells(ligne, 1).Value
       Worksheets("Factures").Cells(ligne, 7).Value = " Rapprochement OK"
       Worksheets("Factures").Cells(ligne, 8).Value = Worksheets("B_Livraison").Cells(cellule.Row, 1).Value
    End If
 End With
 
Next
 
 
End Sub

**tod22** · 23/07/2012, 08h37

Bonjour,
Tout d'abord merci d'avoir répondu.
En ayant modifié le code, un message d'erreur apparaît "erreur d'exécution 424, objet requis" pour la ligne
If Worksheets("B_Livraison").Cells(cellule.Row, 2).Value = Fournisseur And Dat2 = Dat Then
Je ne sais pas quoi faire, est ce lié au fait que le code ne lit plus les noms fournisseurs au début?

**Daniel.C** · 23/07/2012, 10h01

Bonjour,

J'ai peut-être mal compris la disposition de tes données. Peux-tu mettre en pièce jointe un fichier exemple (sans données confidentielles) ?

**tod22** · 23/07/2012, 10h21

Vous trouverez le fichier en pièce jointe.
Merci de votre implication

**gFZT82** · 23/07/2012, 11h37

Bonjour,

Voici une solution avec la méthode Find que tu as employée dans ton code initial.

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
Sub rapprochement_Factures_BL()
Dim Nb_Factures As Long, Nb_BL As Long, Ligne As Long, Prem_occurence As Long
Dim DateFact As Date, DateBL As Date
Dim Cellule As Range
    Nb_Factures = Worksheets("Factures").Range("A65536").End(xlUp).Row    ' on compte le nombre de lignes'
    Nb_BL = Worksheets("B_Livraison").Range("A65536").End(xlUp).Row ' on compte le nombre de BL'
    For Ligne = 2 To Nb_Factures
        'on lit le fournisseur dans la feuille Factures'
        Fournisseur = Trim(Worksheets("Factures").Cells(Ligne, 2).Value)
        'on lit la date dans la feuille Factures'
        DateFact = Worksheets("Factures").Cells(Ligne, 3).Value
        'On recherche dans la feuille B_Livraison le même fournisseur et la même date
        With Worksheets("B_Livraison").Range("B2:B" & Nb_BL)
            'Si c'est le même fournisseur
            Set Cellule = .Find(What:=Fournisseur, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If Not Cellule Is Nothing Then
                Prem_occurence = Cellule.Row
                Do
                    'on lit la date dans la feuille B_Livraison'
                    DateBL = Cellule.Offset(0, 1).Value
                    If DateBL = DateFact Then
                        'on a trouvé , on indique'
                        Worksheets("B_Livraison").Cells(Cellule.Row, 7).Value = " Rapprochement OK"
                        Worksheets("B_Livraison").Cells(Cellule.Row, 8).Value = Worksheets("Factures").Cells(Ligne, 1).Value
                        Worksheets("Factures").Cells(Ligne, 7).Value = " Rapprochement OK"
                        Worksheets("Factures").Cells(Ligne, 8).Value = Worksheets("B_Livraison").Cells(Cellule.Row, 1).Value
                    End If
                  Set Cellule = .FindNext(Cellule)
               Loop While Not Cellule Is Nothing And Cellule.Row <> Prem_occurence
            End If
        End With
    Next
End Sub

Cordialement.

**Daniel.C** · 23/07/2012, 13h27

Bonjour,

Essaie :

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
Sub rapprochement_Factures_BL()
 
 
 
nb_factures = Worksheets("Factures").Range("A65536").End(xlUp).Row    ' on compte le nombre de lignes'
nb_BL = Worksheets("B_Livraison").Range("A65536").End(xlUp).Row
 
For ligne = 2 To nb_factures
 
    'on lit la date'
    Dat = FormatDateTime(Worksheets("Factures").Cells(ligne, 3).Value)
    Dat2 = FormatDateTime(Worksheets("B_Livraison").Cells(ligne, 3).Value)
     With Worksheets("B_Livraison")
        If Dat2 = Dat Then
         ' on a trouvé , on indique'
           .Cells(cellule.Row, 7).Value = " Rapprochement OK"
           .Cells(cellule.Row, 8).Value = Worksheets("Factures").Cells(ligne, 1).Value
           Worksheets("Factures").Cells(ligne, 7).Value = " Rapprochement OK"
           Worksheets("Factures").Cells(ligne, 8).Value = .Cells(cellule.Row, 1).Value
        End If
 
     End With
 
 
Next
 
End Sub

Comparaison de dates

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager