conversion format date en texte en conservant un format de date

J

jujudeo

XLDnaute Nouveau
Bonjour,

J'ai un petit soucis au niveau de mon format de date, j'aimerais transformer mon format de date en texte/standard tout en gardant une écriture sous la forme : "yyyy-mm-dd"

Code: 
Sub Traitement()

 Dim derligne As Long
 Dim x As Range 'cellule affichant le coefficient multiplicateur 100
 Dim taille As Range '1ère ligne contenant le symbole % dans les en-tête
 Dim colonne As Integer 'n° de la colonne à modifier
 Dim lignefin As Integer 'n° de la dernière ligne
 Dim ws As Worksheet
 
 On Error Resume Next 'si la feuille n'existe pas !
 Application.DisplayAlerts = False: Sheets("traitement").Delete: Application.DisplayAlerts = True
 On Error GoTo 0 'plus de gestionnaire d'erreurs
 Worksheets("PO - PB").Copy After:=Worksheets("base donnee") 'création de la feuille
 ActiveSheet.Name = "traitement" 'nom de la feuille'
 Sheets("base donnee").Range("A1:DX1").Copy Sheets("traitement").Range("A1:DX1")
 ActiveSheet.AutoFilterMode = False 'desactiver les filtres'
 ActiveWindow.FreezePanes = False 'désactiver les volets'
 ligne = Range("A" & Rows.Count).End(xlUp).Row
 colomne = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
 With Sheets("traitement")
      Set x = Range("A" & ligne + 10)
           x.Value = 100
           
          Set taille = .Range("A2:DX100")
          For Each cell In taille
          
              If cell.HasFormula = True Then
              cell.EntireColumn.Rows("2:775").Select
              selection.Copy
              selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
          
          
              [b]'detecter date et la mettre en texte + bon format
              ElseIf IsDate(cell) Then
              cell.EntireColumn.Rows("2:761").Select
              selection.NumberFormat = "@"
              selection.NumberFormat = "yyyy-mm-dd"[/b]
                            
             ElseIf InStr(1, cell.Text, "€") > 0 Then
              cell.EntireColumn.Rows("2:761").Select
              selection.NumberFormat = "0.00"  'pour 2 décimales
              selection.Copy
              selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

             ElseIf InStr(1, cell.Text, "%") > 0 Then
               colonne = cell.Column
               lignefin = cell.End(xlDown).Row
               x.Copy
               Range(Cells(1, colonne), Cells(lignefin, colonne)).PasteSpecial _
               Paste:=xlPasteValues, Operation:=xlMultiply, SkipBlanks:=True
                   For i = 2 To lignefin
                     If CStr(Cells(i, colonne)) = "Erreur 2015" Then Cells(i, colonne) = ""
                   Next i
               selection.NumberFormat = "0.00"
               selection.Copy
              selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
            
             End If
            Next
     End With
     
  ActiveSheet.UsedRange.Replace What:="/", Replacement:="", LookAt:=xlWhole
  ActiveSheet.UsedRange.Replace What:="#REF!", Replacement:="", LookAt:=xlWhole
  ActiveSheet.UsedRange.Replace What:="#VALEUR!", Replacement:="", LookAt:=xlWhole
  
         'For Each ws In Worksheets
         'Application.DisplayAlerts = False
         'If ws.Name <> "traitement" Then ws.Delete
         'Next
          'Application.DisplayAlerts = True
     
'ActiveWorkbook.SaveAs Filename:="Traitement", FileFormat:=xlCSV, CreateBackup:=False, local:=True

 End Sub

Voici ma macro, j'arrive à le transformer mais à la fin, le format de ma cellule est personnalisé, et moi je voudrais texte/standard...

Je vous remercie par avance

Julien
 

Pièces jointes

  • suivi.xlsx
    33.1 KB · Affichages: 37
  • suivi.xlsx
    33.1 KB · Affichages: 33
Trier par date Trier par votes
T

thebenoit59

XLDnaute Accro
Re : conversion format date en texte en conservant un format de date

Bonjour jujudeo.
Tu peux adapter ton code ainsi :
Code: 
'detecter date et la mettre en texte + bon format
              ElseIf IsDate(cell) Then
              cell.EntireColumn.Rows("2:761").Select
              Selection.NumberFormat = "@"
              'Selection.NumberFormat = "yyyy-mm-dd"
              For Each c In Range(Cells(2, cell.Column), Cells(761, cell.Column))
                If c.Value <> "" Then c.Value = Format(c.Value, "yyyy-mm-dd")
            Next c
            Selection.NumberFormat = "General"
Je trouve ça un peu lourd mais tu obtiens le résultat escompté.
 
Vote positif 0 Vote négatif
T

thebenoit59

XLDnaute Accro
Re : conversion format date en texte en conservant un format de date

Je te propose une autre solution, voir le fichier joint dont le module 1 correspond au code ci-dessous.
Je suis reparti de zéro. Le résultat s'affiche bien plus rapidement et correctement.

Code: 
Option Explicit
Sub Traitement()

'- Déclaration des variables
Dim dl As Integer, dc As Integer, lf As Integer
Dim r As Range
Dim f1 As Worksheet, f2 As Worksheet, f3 As Worksheet, f4 As Worksheet
Dim c As Variant, k As Variant
Dim dD As Object, dM As Object, dP As Object
Dim T As Long

'- On enregistre les onglets
Set f1 = Feuil1: Set f2 = Feuil12: Set f3 = Feuil2

'- On désactive les application
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'- On débute la procédure
On Error Resume Next
Worksheets("traitement").Delete
'On Error GoTo 0

'- Copie de la feuille PO-PB en dernière position et renomme par traitement
f1.Copy After:=Worksheets(Worksheets.Count)
Set f4 = Worksheets(Worksheets.Count)
f4.Name = "traitement"

'- On copie la ligne 1 de la bdd
With f2
    .Range(.Cells(1, 1), .Cells(1, .Cells.Find("*", , , , xlByColumns, xlPrevious).Column)).Copy f4.Cells(1, 1)
End With

'- On joue avec la feuille traitement (f4)
With f4
    .Activate
    ActiveWindow.FreezePanes = False
    With .Rows("1")
        .EntireRow.AutoFit
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With
    .AutoFilterMode = False
    dl = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    dc = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column

    Set r = .Range(.Cells(2, 1), .Cells(dl, dc))
        r.Copy: .Cells(2, 1).PasteSpecial , Paste:=xlPasteValues: Application.CutCopyMode = False
            Set dD = CreateObject("Scripting.Dictionary"): Set dM = CreateObject("Scripting.Dictionary"): Set dP = CreateObject("Scripting.Dictionary")
                For Each c In r
                    If Left(c.Value, 1) = "/" Or c.Value = 0 Then
                        c.ClearContents
                            ElseIf IsDate(c) Then dD(c.Column) = ""
                                ElseIf InStr(1, c.Text, "€") > 0 Then dM(c.Column) = ""
                                    ElseIf Right(c.Text, 1) = "%" Then dM(c.Column) = "": c.Value = c.Value * 100
                    End If
                Next c
            
        For Each k In dD.Keys
            .Range(.Cells(2, k), .Cells(dl, k)).NumberFormat = "@"
            For Each c In .Range(.Cells(2, k), .Cells(dl, k))
                If c.Value <> "" Then c.Value = Format(c.Value, "yyyy-mm-dd")
            Next c
            .Range(.Cells(2, k), .Cells(dl, k)).NumberFormat = "General"
        Next k
            
        For Each k In dM.Keys: .Range(.Cells(2, k), .Cells(dl, k)).Style = "Comma": Next k
End With

'- On réactive les application
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub
 

Pièces jointes

  • Jujudeo.xlsm
    51.7 KB · Affichages: 50
Vote positif 0 Vote négatif
J

jujudeo

XLDnaute Nouveau
Re : conversion format date en texte en conservant un format de date

je te tiens au courant, je regarde si par rapport a mon fichier d'origine sa n'a pas bougé, mais je crois que c'est bon :) merci beaucoup vraiment ! en plus c'est en bonus c'est rapide ;)
 
Vote positif 0 Vote négatif
J

jujudeo

XLDnaute Nouveau
Re : conversion format date en texte en conservant un format de date

euh :/ les colonne genre monaitaire et % sont en format comptabilité, possible de les passer en format numéro ou standard ?? car le soucis c'est que comme je suis vraiment début en vba cela fais même pas 2 semaines que j'ai commencé, pour modifier ton code je vais avoir un peu de mal car je risque d'identifier d'autre problème au cour de la comparaison
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
J

jujudeo

XLDnaute Nouveau
Re : conversion format date en texte en conservant un format de date

je retire ce que j'ai dit au post #12, j'avais mal fait la modif sa marche très bien ! je viens de me rendre compte que certaines colonnes ont mal été remplies par la personne au niveau de la colonne des dates : 01/0/2013 ou encore 02/08/20145 des exemples comme ceux-la. Est-ce que tu penses qu'il est possible de supprimer / remplacer par du vide dans ces colonnes la, les cellules qui n'ont pas une vrai valeur de date ?
 
Vote positif 0 Vote négatif
T

thebenoit59

XLDnaute Accro
Re : conversion format date en texte en conservant un format de date

Tu peux essayer :
Code: 
For Each k In dD.Keys
            For Each c In .Range(.Cells(2, k), .Cells(dl, k))
                If c.Value <> "" And Not IsDate(c.Value) Then c.ClearContents
            Next c
            .Range(.Cells(2, k), .Cells(dl, k)).NumberFormat = "@"
            For Each c In .Range(.Cells(2, k), .Cells(dl, k))
                If c.Value <> "" Then c.Value = Format(c.Value, "yyyy-mm-dd")
            Next c
            .Range(.Cells(2, k), .Cells(dl, k)).NumberFormat = "General"
        Next k
 
Vote positif 0 Vote négatif

Discussions similaires

W
  • Question
XL 2021 Boucle copier-coller par nom d'en-tête de colonnes
Réponses
10
Affichages
318
whiteshark
W
F
  • Résolu(e)
XL 2021 fermeture du classeur après apple d'un userform d'un autre classeur ouvert
Réponses
2
Affichages
95
farid
F
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
523
mouchtre
mouchtre
halecs93
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
536
halecs93
halecs93
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
183
Nico2978
Nico2978
E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
148
eric72
E
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
77
Latias
L
M
  • Résolu(e)
XL 2016 Filtre auto VBA
Réponses
3
Affichages
577
MickaeL_D
M
D
  • Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
355
crocrocro
C
M
  • Résolu(e)
XL 2016 mail en automatique dans excel destinataire en fonction de la valeur d une cellule
Réponses
11
Affichages
708
mathieu20
M

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 41 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 206
Messages
2 086 207
Membres
103 157
dernier inscrit
youma