Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 Intégrer une conversion date xx en 20 xx dans macro vba excel

saunier

XLDnaute Nouveau
Bonjour à tous,

Mon projet est de mettre à jour un fichier de suivi d'une activité à partir d'une extraction issue de notre logiciel entrepôt (wms).Dans un précédent message j'ai obtenu de l'aide très efficace !! de vgendron, pour une macro qui permet de comparer le fichier de suivi et l'extraction est mettre à jour les données quand nécessaire.

Pour finaliser mon projet j'ai encore besoin de votre aide. Les colonnes de dates contenues dans l'extraction dans un format non exploitable. Excel propose de convertir au format xx vers 20xx. Mais je n'ai pas réussi à intégrer cette conversion dans la macro.

Je précise que je débute en VBA. J'ai essayé de passer par une macro enregistré mais ça ne fonctionne pas. Je vous mets ci dessous la macro proposée et je joint un exemple du fichier à mettre à jour et de l'extraction :

Sub update()
Dim TabSuivi() As Variant
Dim TabExtract() As Variant

With Sheets("Suivi")
fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne non vide de la colonne A
TabSuivi = .Range("A2:J" & fin).Value 'on met dans un tablo
End With

With Sheets("extraction")
fin = .Range("A" & .Rows.Count).End(xlUp).Row
TabExtract = .Range("A2:J" & fin).Value
End With


Merci par avance de vos aides !

For i = LBound(TabExtract, 1) To UBound(TabExtract, 1) 'pour chaque ligne du tablo
DéjàListé = False
For j = LBound(TabSuivi, 1) To UBound(TabSuivi, 1) 'on cherche si le code existe déjà
If TabSuivi(j, 2) = TabExtract(i, 2) Then
DéjàListé = True
'on met à jour la ligne
For col = LBound(TabSuivi, 2) To UBound(TabSuivi, 2)
TabSuivi(j, col) = TabExtract(i, col)
Next col

Exit For
End If
Next j
If Not (DéjàListé) Then
'il faut ajouter une ligne
With Sheets("Suivi")
fin = .Range("A" & .Rows.Count).End(xlUp).Row
For col = LBound(TabSuivi, 2) To UBound(TabSuivi, 2)
.Cells(fin + 1, col) = TabExtract(i, col)
Next col
End With
End If
Next i

With Sheets("Suivi")
.Range("A2").Resize(UBound(TabSuivi, 1), UBound(TabSuivi, 2)) = TabSuivi
End With

End Sub
 

Pièces jointes

  • OPS.xls
    350.5 KB · Affichages: 4
  • projet OPS - Copie.xlsm
    709.6 KB · Affichages: 2

Deadpool_CC

XLDnaute Accro
Dans la logique, C'est à l'importation des données dans ta feuille extraction qu'il faudrait convertir ces dates "texte" en date "Date Excel"
Tu t'y prend comment pour importer tes données dans Excel ?
j'ai pas trouver de code VBA qui te le fait donc c'est manuel ?
 

saunier

XLDnaute Nouveau
Bonjour,
Oui je sais qu'il serai opportun de faire modifier l'extraction sauf qu'il faut pour cela s'appuyer sur notre service informatique et cela va prendre des lustres. C'est pourquoi je voudrais contourner cela.
 

Deadpool_CC

XLDnaute Accro
il te fournissent directement l'excel ? ou un CSV que t'as enregistré toi même en .xls ?

Et tu fais l'import souvent ?
car si une fois de temps en temps pout tes 3 colonnes date dans extraction, du selectionne la colonne (Ex: "A") tu vas dans données / Convertir (2x suivants puis choisi format "date" JMA et fait termniner
tu répète cela pour chaque colonne date et c'est bon

Après si tu dois le faire chaque jour alors il va falloir faire un code VBA pour te l'automatiser.
 
Dernière édition:

Deadpool_CC

XLDnaute Accro
Dans ta fonction update, je me suis contenté de forcer le format des données des 3 colonnes de extraction
et j'ai revu le format de tes colonnes de dates dans suivi OPS


VB:
Sub update()
Dim TabSuivi() As Variant
Dim TabExtract() As Variant

Sheets("extraction").Activate
    Columns("A:A").Select
    Range("A1").Activate
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
    Columns("F:F").Select
    Range("F1").Activate
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
    Columns("J:J").Select
    Range("J1").Activate
    Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
    Range("J1").Select
Sheets("Suivi OPS").Activate

With Sheets("Suivi OPS")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne non vide de la colonne A
    TabSuivi = .Range("A2:J" & fin).Value 'on met dans un tableau
End With

With Sheets("extraction")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabExtract = .Range("A2:J" & fin).Value
End With

For i = LBound(TabExtract, 1) To UBound(TabExtract, 1) 'pour chaque ligne du tablo
    DéjàListé = False
    For j = LBound(TabSuivi, 1) To UBound(TabSuivi, 1) 'on cherche si le code existe déjà
        If TabSuivi(j, 2) = TabExtract(i, 2) Then
            DéjàListé = True
            'on met à jour la ligne
            For col = LBound(TabSuivi, 2) To UBound(TabSuivi, 2)
                TabSuivi(j, col) = TabExtract(i, col)
            Next col
            
            Exit For
        End If
    Next j
    If Not (DéjàListé) Then
        'il faut ajouter une ligne
        With Sheets("Suivi OPS")
            fin = .Range("A" & .Rows.Count).End(xlUp).Row
            For col = LBound(TabSuivi, 2) To UBound(TabSuivi, 2)
                .Cells(fin + 1, col) = TabExtract(i, col)
            Next col
        End With
    End If
Next i

With Sheets("Suivi OPS")
    .Range("A2").Resize(UBound(TabSuivi, 1), UBound(TabSuivi, 2)) = TabSuivi
End With

End Sub
 

Pièces jointes

  • projet OPS - Copie.xlsm
    777.1 KB · Affichages: 1

saunier

XLDnaute Nouveau
c'est justement car je le fais plusieurs fois par jour que je voudrais de l'aide pour faire un code VBA qui automatise la conversion
 

Discussions similaires

Réponses
4
Affichages
454
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…