Macro excel ; probleme variable en date

Fermé
Bouhyaa - 21 déc. 2011 à 16:04
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 24 déc. 2011 à 08:20
Bonjour,
J'essaye desesperement de réaliser une macro qui recupere des dates en fonction de certains critères.
Pour vous expliquer simplement, j'ai 2 feuilles de données comprenant de grande quantités d'info. J'ai besoin de recuperer les dates correspondantes à des codes article pour les réinssérer dans l'autre feuille à la bonne ligne bien sur. Seulement voila ce n'est pas tout, je doit recupérer la date la plus tardive des articles dont le nom se termine par " B" (espace B) et la date la plus tardive des autrers.
J'ai eu des problemes de compatibilité de variables ce qui peu expliquer le debut bizarre, voici mon code intégrale ( j'insere des date trers ancienne dans les case vide pour ne pas faire planter mes variables de format "date", puis je les enleves a la fin pour ne pas deteriorer le fichier d'origine)...



Public Sub base()

Dim i, j As Integer
Dim hdate As Date, DateLimiteBrut As Date, DateLimiteAppro As Date, DateBrut As Date, DateAppro As Date
Dim NbLigneB1 As Integer, NbLigne As Integer, DesignationProduit As String, x As Currency

'=================== Prerequis =========================
Windows("B1.xlsm").Activate
Columns("L:L").Select ' mets la date dans le formant reconnu par la macro
Selection.NumberFormat = "dd/mm/yy"

Windows("B2.xlsx").Activate
Range("B1").Select ' Selectionne la première cellule du tableau
Do While Not (IsEmpty(ActiveCell)) ' Boucle tant que pas vide
    NbLigne = NbLigne + 1
    Selection.Offset(1, 0).Select
Loop

Windows("B1.xlsm").Activate
Range("N1").Select ' Selectionne la première cellule du tableau
Do While Not (IsEmpty(ActiveCell)) ' Boucle tant que pas vide
    NbLigneB1 = NbLigneB1 + 1
    Selection.Offset(1, 0).Select
Loop

j = 1
While j < NbLigneB1 + 1
    Windows("B1.xlsm").Activate
    Range("L" & j).Select
    r = ActiveCell.Text
    If r = "" Then
        ActiveCell.FormulaR1C1 = 10 / 10 / 2000
        Range("ZZ" & j).Select
        ActiveCell.FormulaR1C1 = 1
        'Range("ZY" & j).Select
        'ActiveCell.FormulaR1C1 = "=CONCATENATE(""#"",RC[-689],""#"")"
    End If
    j = j + 1
Wend

i = 1
j = 1
hdate = 1 / 1 / 2001
DateLimiteAppro = 1 / 1 / 2001
DateLimiteBrut = 1 / 1 / 2001


    
'================== Programme =====================
Do While i < NbLigne + 1
    
    Windows("B2.xlsx").Activate '////
    Range("B" & i).Select '////////// Extraction de l'AR du fichier PORTANF
    AR = ActiveCell.Text '///////////
    
    'Do While j < NbLigneB1 + 1
        Windows("B1.xlsm").Activate '////
        Range("N" & j).Select '////////// Extraction de l'AR de la premiere ligne du progatel
        x = ActiveCell.Text '////////////
        
        Do While AR = x

            
            Range("C" & j).Select
            DesignationProduit = ActiveCell.Text
            Windows("B1.xlsm").Activate
            Range("ZY" & j).Select
            hdate = ActiveCell.Text
            
            
            If Right(DesignationProduit, 2) = " B" Then '///////////////////
                DateBrut = hdate '//////////////////////////////////////////
                If DateBrut > DateLimiteBrut Then '/////////////////////////////
                    DateLimiteBrut = DateBrut '/////////////////////////////////
                End If '////////////////////////////////////////////////////////
           
            Else '//////////////////////////////////////////////////////////
        
                DateAppro = hdate '/////////////////////////////////////////
                If DateAppro > DateLimiteAppro Then '///////////////////////////
                    DateLimiteAppro = DateAppro '///////////////////////////////
                End If '////////////////////////////////////////////////////////
            End If '////////////////////////////////////////////////////////
            
            Windows("B2.xlsx").Activate 'inscrit la date limite des _B
            Range("C" & i).Select
            ActiveCell.FormulaR1C1 = DateLimiteBrut
            
            Windows("B2.xlsx").Activate 'inscrit la date limite des Appro
            Range("D" & i).Select
            ActiveCell.FormulaR1C1 = DateLimiteAppro
            
            'MsgBox ("i=" & i & "  " & "j=" & j & "  " & "x=" & x)
            j = j + 1
            
            If j < NbLigneB1 + 1 Then
            Windows("B1.xlsm").Activate '////
            Range("N" & j).Select '////////// Extraction de l'AR de la premiere ligne du progatel
            x = ActiveCell.Text '////////////
            Else
            End If
        Loop
        'MsgBox ("hdate=" & hdate & "  " & "DateLimiteBrut=" & DateLimiteBrut & "  " & "DateLimiteAppro=" & DateLimiteAppro)
        
         
    
        
    
    i = i + 1

Loop

'===============Cloture/Remise en forme=========================
j = 1
While j < NbLigneB1 + 1
    Windows("B1.xlsm").Activate
    Range("ZZ" & j).Select
    r = ActiveCell.Text
    If r = 1 Then
        Range("L" & j).Select
        ActiveCell.FormulaR1C1 = ""
        Range("ZZ" & j).Select
        ActiveCell.FormulaR1C1 = ""
        'Range("ZY" & j).Select
        'ActiveCell.FormulaR1C1 = ""
    End If
    j = j + 1
Wend

Windows("B1.xlsm").Activate
Columns("L:L").Select ' remet la date dans son format progatel
Selection.NumberFormat = "ddmmyy"

End Sub





Mon probleme est le suivant, il ne me ressort soit :
- que des données (imcompréhenssible) en heures au lieu de dates, si je laisse les dates sous la forme jj/mm/aa et que je laissse les variables en "date"
- que des (01/01/2000) quand je met les dates sous la forme #jj/mm/aa# et que je met les variable sous la forme "string"

je ne conprends plus rien, je ne vois pas dutout ou est l'erreure, vous m'aideriez enormement en me disant comment regler mon probleme.
Si vous pensez que je me suis rendu la vie plus difficile que necessaire je suis pret a prendre vos propositions ;)

merci d'avance
A voir également:

1 réponse

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
Modifié par michel_m le 21/12/2011 à 16:52
Bonjour

manipuler les dates avec VBA est toujours un affreux B....

mon truc est de transformer les dates en leur numéro de série depuis le 1/1/1900
avec la fonction dateserial et de les remettre au format lorsque je les envoie dans les feuilles
par ex
valeur = DateSerial(2000, 12, 31) '31 décembre 2000  
With Range("A1")  
     .Value = valeur  
     .NumberFormat = "m/d/yyyy"   
end with

bien sûr, dans ta macro, tu peux grouper toutes les mises au format date francaise (tu remarqueras que la syntaxe de numberformat est à la mode anglaise

astuce à la première de tes prérequis écris
Application.screenupdating=False 

ca tévitera d'avoir ton écran avec des vues qui sautent et/ou qui se balladents dans la feuille et tu ganes un temps fou( environ 80 fois)

dem^me évite les activate et select par ex
With Windows("B2.xlsx").Sheets("tafeuille")
nblign = Range("B1").End(xlDown).Row + 1
Cells(nblign, "B").Select
end with

à quoi sert ce select à la fin puisque dès que tu retournes dans B2 tu fais un select sur une autre cellule (Range("B" & i).Select)?
Important indique toujours dans quelle feuille tu travailles et résonne par bloc With....end with sans oublier les points devant les range ou cells
Michel
0
Merci de tes differentes astuces ;) il est vrai que ma macro mets un temps fou a se réaliser ^^je vais essayer d'appliquer les modifications que tu m'a apporter et de simplifier ma macro ;)
merci de ton aide
0
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
23 déc. 2011 à 13:13
Bonjour, bonjour Michel,
Tu dit..
astuce à la première de tes prérequis écris
Application.screenupdating = False

Mais oublie pas de remettre à la fin de la macro (en dernière ligne)
Application.screenupdating = True
A+
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
Modifié par michel_m le 23/12/2011 à 13:27
Bonjour lermite
Mais oublie pas de remettre à la fin de la macro (en dernière ligne)
Application.screenupdating = True


Ce n'est pas obligé puisque la macro rend la main au système et le booléen screeenupdating s'éteint lorsque la macro rend la main au système . source:Laurent Longre mais son site ne répond plus
Par contre si il y a appel d'une macro , il faut regarder les effets sur la macro appelée
0
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
23 déc. 2011 à 21:12
Je ne savais pas :-)
Mais je ne pense pas que cela devrait avoir des implications sur d'autre appel de fonction, le screenUpdating annule simplement le rafraîchissement de l'écran mais les données sont enregistrées directement dans les tableaux. Du moins c'est mon avis. (vaux mieux être prudent dans ce que je dis) ..
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 711
23 déc. 2011 à 23:19
Bonjour à vous,

et le booléen screeenupdating s'éteint lorsque la macro rend la main au système

Je n'en suis pas aussi sûr que cela, car comme j'avais vu l'info de Michel, j'ai voulu la mettre en pratique et en fait, j'ai été obligé de remettre le paramètre à true : j'avais un tri de la feuille avec repositionnement sur la bonne ligne et l'arrêt de la macro laissait l'affichage de la page en l'état, nécessitant une action, pour avoir un repositionnement correct.
Lorsque l'on met les instructions elles sont exécutées, autrement il suffit qu'une mise à jour d'office change un peu une fonctionnalité pour que le résultat ne soit plus le même.
Ce que :Laurent Longre dit, est probablement valable pour 2003, à un certain moment, mais ce n'est plus le cas aujourd'hui ni sur 2007/2010 : c'est du moins ce que j'ai constaté.

Bonnes fêtes à vous.
0