conversion format date en texte en conservant un format de date

[jujudeo]

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"

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

 

[thebenoit59]

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

Bonjour jujudeo.
Tu peux adapter ton code ainsi :

'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é.

 

[jujudeo]

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

ça marche mais effectivement sa prend pas mal de temps :/

 

[thebenoit59]

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.

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

 

[jujudeo]

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

merci beaucoup mais le fichier que je donnais, était juste un exemple pour que vous visualiser le résultat :/

 

[thebenoit59]

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

Je me doute bien, mais si les tableaux correspondent, c'est à dire débuter ligne 2, colonne A pour les données.
La procédure sera tout à fait adapter.

 

[jujudeo]

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

Ton code est juste P A R F A I T :0 je sais même comment te remercier... c'est juste terrible ce que tu as fait je te remercie beaucoup !!!

 

[thebenoit59]

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

Il fonctionne bien sur tes fichiers ?

 

[jujudeo]

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

 

[jujudeo]

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

 

[thebenoit59]

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

Modifie la ligne correspondante :

For Each k In dM.Keys: .Range(.Cells(2, k), .Cells(dl, k)).NumberFormat = "0.00": Next k

 

[jujudeo]

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

je l'ai mis a la ligne correspondante mais j'ai un problème de next

 

[thebenoit59]

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

A quelle ligne ?
Peux-tu poster une impression d'écran ?

 

[jujudeo]

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 ?

 

[thebenoit59]

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

Tu peux essayer :

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