VBA format de date (dans une variable range)

Le 23/08/2017 à 14:16

Bonjour à tous,

Je dois avouer que le titre n'est peut être pas le plus précis, mais je n'ai pas trouvé mieux !

Mon problème est connu, sur le problème des dates qui sont en JJ/MM/AAAA et qui passent en MM/JJ/AAAA après avoir été travaillé dans une macro, mon problème est légèrement plus compliqué (de mon point de vue).

Afin d'optimiser la rapidité d'exécution de ma macro, qui travaille sur plusieurs feuilles, j'ai trouvé dans le forum une astuce qui permet de mettre les zones de travail dans une variable en variant, de travailler sur le variant, et de recopier les feuilles à la fin.

Le problème intervient lorsque je recopie le variant sur ma feuille à la fin de la macro, certaines dates passent en format anglais. Je ne trouve nulle part comment faire pour que dans un variant je puisse lui dire que la colonne P correspond à une date en JJ/MM/AAAA.

Afin de contourner le problème, j'ai essayé de recopier toutes les colonnes sauf la colonne P afin d'éviter le changement de date mais je n'ai pas réussi non plus.

Voici la macro (les variables sont déclarées en public dans un autre module) :

 
Sub Formate()

Dim EcartLiv, commande, i, dernligne, v As Variant
Dim sngChrono As Single

dernligne = Feuil2.Range("A" & Rows.Count).End(xlUp).Row 'feuille SQ01

Set rg = Worksheets("SQ01").Range("A1:AD" & dernligne)
v = rg
EcartLiv = 0
DateNow = CDate("1/" & Format(DateAdd("m", -0, Date), "mm/yyyy"))

For i = 2 To dernligne
    If IsEmpty(v(i, 25)) Then ' si pas déjà vérifié (optimisation du temps de calcul)

            commande = v(i, 2) & v(i, 5)
            DateLiv = v(i, 11)
            DateCpt = v(i, 16)

            For j = 2 To dernligne 'pour chaque ligne de commande du fichier SQ01
            commande2 = v(j, 2) & v(j, 5)
                If commande2 = commande Then 'si c'est la meme commande
                    v(j, 25) = "X"
                    If DateCpt <= v(j, 16) Then 'si la date de livraison est superieur à la 1ere
                        DateCpt = v(j, 16) 'alors tu la garde en mémoire
                        ligne = j
                    End If
                End If
            Next

            If DateCpt = DateLiv Then 'si le fournisseur a livré à la date stat
                EcartLiv = 0

                If v(ligne, 17) <> "122" Then
                    If v(ligne, 14) >= v(ligne, 12) - (v(ligne, 12) * 0.1) Then 'Et Si la ligne est complète a +/- 10% alors
                        If DateCpt = DateLiv Then v(ligne, 26) = "On Time"
                    Else 'sinon si la ligne n'est pas complète alors
                        v(ligne, 26) = "Non Delivered"
                        v(ligne, 28) = "Non Completely delivered"

                    End If

                    v(ligne, 27) = EcartLiv

                    If DateCpt = 0 Then v(ligne, 26) = "Non Delivered"

                ElseIf v(ligne, 17) = "122" Then 'si la dernière ligne est un retour alors :
                    v(ligne, 26) = "Non Delivered"
                    v(ligne, 28) = "Parts returned"

                End If
            End If

             If DateCpt < DateLiv Then 'si le fournisseur a livré avant la date stat
                If DateCpt <> 0 Then
                    EcartLiv = NbJoursOuvres(DateCpt, DateLiv) - 1 'si c'est quand même livré alors écart liv = date stat - date réception
                ElseIf DateCpt = 0 Then
                    EcartLiv = NbJoursOuvres(DateLiv, DateNow) - 1  'si c'est pas livré alors écart liv = date stat - date du 1er du mois

                End If

                If v(ligne, 17) <> "122" Then
                    If v(ligne, 14) >= v(ligne, 12) - (v(ligne, 12) * 0.1) Then 'Si la ligne est complète a +/- 10% alors
                        If EcartLiv >= 3 Then v(ligne, 26) = "Early" 'si il a livré avant 3 jours alors c'est en avance
                        If EcartLiv < 3 And EcartLiv >= 1 Then v(ligne, 26) = "On Time" 'si il a livré entre 3 jours max et 1 jour alors c'est à l'heure
                    Else 'si la ligne n'est pas complète alors
                        v(ligne, 26) = "Non Delivered"
                        v(ligne, 28) = "Non Completely delivered"
                    End If

                    v(ligne, 27) = EcartLiv

                    If DateCpt = 0 Then v(ligne, 26) = "Non Delivered"

                ElseIf v(ligne, 17) = "122" Then 'si la dernière ligne est un retour alors :
                    v(ligne, 26) = "Non Delivered"
                    v(ligne, 28) = "Parts returned"

                End If
            End If

            If DateCpt > DateLiv Then 'si le fournisseur à livré après la date stat
                EcartLiv = NbJoursOuvres(DateLiv, DateCpt) - 1

                If v(ligne, 17) <> "122" Then
                    If v(ligne, 14) >= v(ligne, 12) - (v(ligne, 12) * 0.1) Then 'Si la ligne est complète a +/- 10% alors
                        If EcartLiv >= 2 And v(ligne, 16) < DateAdd("m", 1, DateSerial(Year(v(ligne, 11)), Month(v(ligne, 11)), 1)) Then v(ligne, 26) = "Late"
                        If EcartLiv >= 2 And v(ligne, 16) > DateAdd("m", 1, DateSerial(Year(v(ligne, 11)), Month(v(ligne, 11)), 1)) Then v(ligne, 26) = "Non Delivered"
                        If EcartLiv = 1 Then v(ligne, 26) = "On Time"
                    Else
                        v(ligne, 26) = "Non Delivered"
                        v(ligne, 28) = "Non Completely delivered"
                    End If

                    v(ligne, 27) = EcartLiv

                    If DateCpt = 0 Then v(ligne, 26) = "Non Delivered"

                ElseIf v(ligne, 17) = "122" Then
                    v(ligne, 26) = "Non Delivered"
                    v(ligne, 28) = "Parts returned"

                End If
            End If

    End If
Next

rg = v
Worksheets("SQ01").Range("A1:P" & dernligne) = rg
'Worksheets("SQ01").Range(Columns(1), Columns(2)) = rg.Range(Columns(1), Columns(2)).Value2

End Sub

Mon problème se situe donc à la ligne :

rg = v
Worksheets("SQ01").Range("A1:P" & dernligne) = rg

Merci d'avance pour votre aide.

EDIT1: Voici un lien pour le fichier allégé : https://www.cjoint.com/c/GHxmIOuTHDj

Alexandre.

Le 23/08/2017 à 14:19

Bonjour,

Je viens de l'apprendre il y a 5 minutes. Essai

rg = v
Worksheets("SQ01").Range("A1:P" & dernligne) = Cdate(rg)

Cdlt,

Le 23/08/2017 à 14:20

Bonjour,

sans une copie de fichier...

P.

Le 23/08/2017 à 14:22
VH_AE a écrit :

Bonjour,

Je viens de l'apprendre il y a 5 minutes. Essai

rg = v
Worksheets("SQ01").Range("A1:P" & dernligne) = Cdate(rg)

Cdlt,

Bonjour VH_AE

Je viens d'essayé mais j'ai une imcompatibilité de type car dans mon range "rg" j'ai de tout (nombre, dates, texte...)

Merci quand même pour ton aide !

Alexandre

patrick1957 a écrit :

Bonjour,

sans une copie de fichier...

P.

Bonjour patrick1957,

Effectivement je savais que j'allais avoir la remarque .

Mon problème est que le fichier est gros (30 mo) et que si je supprime quelques pages, je pense que la macro ne fonctionnera plus.

Je vais quand même tenter, même si elle ne fonctionne plus par ce qu'il n'y a plus les références, au moins il y aura "l'esprit" du fichier.

Merci pour ta remarque.

Alexandre

Le 23/08/2017 à 14:35

Re,

rg = v

If Isdate(Rg) Then

Worksheets("SQ01").Range("A1:P" & dernligne) = Cdate(rg)

Else 

Worksheets("SQ01").Range("A1:P" & dernligne) = rg

End if

Peut être ?

Cdlt,

Le 23/08/2017 à 14:40

VH_AE,

Merci pour ta réponse, je vois le principe de la méthode, tester chaque cellule dans le range pour voir si c'est une date, et la recopier dans le bon format, mais si j'utilise cette méthode, je perds toute l'optimisation que j'avais faite avant, car il va devoir tester chaque cellules et les recopier une par une à la place de tout faire d'un coup.

Effectivement si je ne trouve pas de solution "simple et rapide" je regarderai pour me tourner vers ce type de solution...

Alexandre.

Le 23/08/2017 à 14:52

Re,

Désolé, je n'ai jamais eu à optimiser une de mes macro mais je comprend ton problème. Ne peut tu pas effectuer le test et l'application du format au moment de la récupération des données ? au lieu qu'a la retranscription. Cela devrait aussi ralentir ta macro.

J'ai aucune idée de comment fonctionne les "Variant" mais sinon il faudrait récupérer les positions des occurrences qui sont des dates et leurs appliquer le format. Il s'agit de factoriser la tâche en fait.

Cdlt,

Le 24/08/2017 à 11:34

Bonjour,

Quelqu'un d'autre à t'il une idée pour mon problème

Merci pour votre aide !

Alexandre

Rechercher des sujets similaires à "vba format date variable range"