VBA excel extraire le mois et l'année d'une date au format standard

Aimedija · 6 Juillet 2018

Bonjour,

Ayant un niveau moyen en VBA et n'ayant pas trouver de réponse satisfaisante sur ce site , je me permet de poser cette question : comment extraire le mois et l'année d'une date au format standard (par défaut) ;

J'ai ici un code qui me permet de copier la date pour des cellules vides d'une colonne à une autre dans un même workbook que je désire modifier.

La date d'origine est 20180625 et je souhaiterais obtenir un résultat 06/2018 (mois/année)

Code:

Private Sub FillInEmpty()

Dim lastRow As Long

Dim I As Long

Dim ws As Worksheet

Dim Rep As Integer

Set ws = Sheets("Page1_1")


  Rep = MsgBox("Are you willing to copy all dates into this column?", vbYesNo + vbQuestion, "mDF XLpages.com")
  If Rep = vbYes Then

With ws
lastRow = Cells(rows.count, 35).End(xlUp).Row


For I = lastRow To 2 Step -1

  If Cells(I, 35).Value = "" Then

  Cells(I, 35).Value = Cells(I, 29).Value

  End If

Next I
End With

Else

End If

Set ws = Nothing

End Sub

j'ai essayé d'introduire la notion de : LaDate = format(now, "mm-aaaa") mais j'ai des difficulté à adapter mon code d'origine.

Est ce que quelqu'un aurais une idée? merci d'avance

job75 · 10 Juillet 2018

Bonsoir Aimedija,

C'est un peu le foutoir ce fil !

Au post #1 vous vouliez le format "mm/aaaa", maintenant je vois dans votre code le format "mmmm-yyyy"...

Alors essayez cette macro :

Code:

Sub RemplirColonne35()
Dim t, i&, x$
With Feuil1.ListObjects(1).DataBodyRange.Columns(29).Resize(, 7)
    t = .Value ' matrice, plus rapide
    For i = 1 To UBound(t)
        x = t(i, 1)
        If x <> "" And t(i, 7) = "" Then _
            t(i, 7) = Application.Proper(Format("1/" & Mid(x, 5, 2), "mmmm ")) & Left(x, 4)
    Next
    .Columns(7).NumberFormat = "@" 'format texte
    .Columns(7) = Application.Index(t, , 7)
End With
End Sub

S'agissant d'un tableau Excel il ne faut pas entrer de formule en colonne AI (35).

Bonne nuit.

job75 · 11 Juillet 2018

Bonjour Aimedija, le forum,

On peut sans inconvénient utiliser une macro évènementielle :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, t, i&, x$
With ListObjects(1).DataBodyRange 'tableau Excel
    On Error Resume Next 'si aucune SpecialCell
    Set r = Intersect(.Columns(29).SpecialCells(xlCellTypeConstants).EntireRow, .Columns(35).SpecialCells(xlCellTypeBlanks).EntireRow)
    On Error GoTo 0
End With
If r Is Nothing Then Exit Sub
Application.EnableEvents = False 'désactive les évènements
For Each r In r.Areas 'si entrées/suppressions multiples
    t = r.Columns(29).Resize(, 7) ' matrice, plus rapide
    For i = 1 To UBound(t)
        x = t(i, 1)
        t(i, 7) = Application.Proper(Format("1/" & Mid(x, 5, 2), "mmmm ")) & Left(x, 4)
    Next i
    r.Columns(35).NumberFormat = "@" 'format Texte
    r.Columns(35) = Application.Index(t, , 7)
Next r
Application.EnableEvents = True 'réactive les évènements
End Sub

Les cellules vides de la colonne AI (35) se remplissent quand on modifie une cellule quelconque.

Fichier joint.

A+

job75 · 11 Juillet 2018

Re,

On remarquera que les cellules en colonne AI sont remplies même si les valeurs en colonne AC sont erronées.

On peut utiliser cette macro pour contrôler quand on veut la colonne AC (29) :

Code:

Sub VérificationColonne29()
Dim t, i&, x$, y As Byte
With ListObjects(1).DataBodyRange.Columns(29) 'tableau Excel
    t = .Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To UBound(t)
        x = CStr(t(i, 1)): y = Val(Mid(x, 5, 2))
        If x <> "" And Not x Like "######*" Or y > 12 Or y = 0 Then
            .Cells(i, 1).Select
            MsgBox "Valeur erronée en " & ActiveCell.Address(0, 0) & " !", 48
            End
        End If
    Next
    MsgBox "Toutes les valeurs en " & .Address(0, 0) & " sont correctes..."
End With
End Sub

A+

ChTi160 · 11 Juillet 2018

Bonjour
Bonjour le Fil ,le Forum
Bien que de nombreuses propositions font le Job

je suis resté sur le Format du Post#1 et pas de tableau(ListObject)

je souhaiterais obtenir un résultat 06/2018 (mois/année)

Bonne fin de journée
jean marie

Aimedija · 11 Juillet 2018

Bonjour Jean-Marie,
Bonjour Job75,

Vos codes sont tout simplement parfait, j'ai pu les adapter à mes besoins. Merci à tous et bonne soirée

Aimedija · 17 Juillet 2018

Bonjour le fil,
Bonjour le forum,
Merci pour ses codes que j'ai pu adapter , je reste néanmoins bloqué sur un autre probléme ;

Je souhaiterais effectuer la même opération mais cette fois ci pour des valeurs dans la colonne AI qui commence par 000000 suivis de quatre chiffres (0000002323 par exemple, qui peuvent varier à l'infinis ). J'essaye le code ci-dessous sans résultat :

Code:

With ws.ListObjects(1).DataBodyRange.Columns(29).Resize(, 7)
  t = .Value ' matrice, plus rapide
  For I = 1 To UBound(t)
  x = t(I, 1)
  If x <> "" And t(I, 7) = "*000000####*" Then _
  t(I, 7) = Application.Proper(Format("1/" & Mid(x, 5, 2), "mm-")) & Left(x, 4)

et j'aimerais aussi faire de même si les valeurs en colonne AI sont de type texte ( Passion ou Provision, qui peuvent varier et ne sont jamais les mêmes) . Cette fonction ne fonctionne pas dans ce cas précis :

Code:

= like ("Passion")

Est ce que quelqu'un pourrais m'éclairer? Mes excuses si je dois créer un autre fil.
Merci d'avance et bien à vous.

ChTi160 · 17 Juillet 2018

Bonjour
si ton texte commence par "000000"
il faut quelque chose comme ceux ci :

If x <> "" And t(I, 7) Like "000000####*" Then

car cette formulation :

t(I, 7) = "*000000####*"

veut dire que t(I,7) Contient ce "*000000####*"
Bonne fin de Soirée
Jean marie

Aimedija · 18 Juillet 2018

Bonjour Jean-Marie,
Bonjour le forum,

Un grand merci mais cette alternative ne me donne aucun résultat

Code:

 "000000####*"

. Est ce que quelqu'un aurais une autre solution?

Merci d'avance

ChTi160 · 18 Juillet 2018

Bonsoir Aimedija
Bonsoir le Fil ,le Forum
Sans un fichier anonymisé (de ce que tu as et de ce que tu veux),on ne peut pas grand chose !
Dans l'attente
Bonne fin de Soirée
Jean marie

Aimedija · 19 Juillet 2018

Bonjour jean-Marie,
Bonjour le forum, le fil,

Merci de trouver ci-joint un fichier d'exemple. j'ai revue le code source afin de mieux cerner le probléme. L'alternative que tu me propose semble la plus adapté. Néanmoins, lorsque je cherche à remplacer un texte ( en colonne AI : 0000002323 ) par la date de la colonne AC , j'obtiens le résultat suivant ; 10/1912.

Pourrais tu m'aider à cerner le probléme? merci d'avance

ChTi160 · 19 Juillet 2018

Bonjour
Bonjour le Fil ,le Forum
voilà ce que j'ai modifié dans la Procédure et qui semble répondre à la Demande

VB:

For i = 1 To UBound(Tab_Temp, 1)
     Year_Date = Mid(Tab_Temp(i, 29), 1, 4) 'on récupère l'année
          Month_Date = Mid(Tab_Temp(i, 29), 5, 2) 'On récupère le Mois
  If Tab_Temp(i, 35) = "" Or Tab_Temp(i, 35) Like "000000####*" Then 'le contenu de la colonne est vide ou contient des données de ce Format
          Tab_Recup(i, 1) = DateSerial(Year_Date, Month_Date, 1) 'on colle la Date ainsi formatée
  Else
          Tab_Recup(i, 1) = Tab_Temp(i, 35) 'on conserve le contenu de la colonne  
  End If
Next i

voir le fichier joint
Bonne fin de journée
Jean marie

job75 · 19 Juillet 2018

Bonjour Almedija, ChTi160, le fil,

Donc maintenant vous voulez le mois en chiffres ?

Code:

Sub RemplirColonne35()
Dim t, i&, x$
With Feuil2.[A1].CurrentRegion.Columns(29).Resize(, 7)
    t = .Value2 ' matrice, plus rapide
    For i = 2 To UBound(t)
        x = t(i, 1)
        If x <> "" And t(i, 7) Like "000000####*" Then _
            t(i, 7) = Format("1/" & Mid(x, 5, 2), "mm/") & Left(x, 4)
    Next
    .Columns(7).NumberFormat = "mm/yyyy" 'format Date
    .Columns(7) = Application.Index(t, , 7)
End With
End Sub

A+

Modeste geedee · 19 Juillet 2018

Bonsour®
afin déviter les années 1903 ???
utiliser la valeur text des cellules concernées
comme ceci :

VB:

Public Sub FillInEmpty()

Dim lastRow As Long 'depuis excel 2007, un integer ne suffit plus pour compter les lignes ...
Dim DerCol As Byte
Dim i As Long 'Quitte à déclarer tes variables, déclare les toutes ...
Dim ws As Worksheet
Dim Rep As Integer
Set ws = Sheets("Page1_1")
    Rep = MsgBox("Are you willing to copy all dates into this column?", vbYesNo + vbQuestion, "xld")
    If Rep # vbYes Then exit sub

 Application.ScreenUpdating = False
With ws
 lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
  DerCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = 1 To lastRow
  If .Cells(i, DerCol) = "" Then
           Year_Date = Mid(.Cells(i, 29).Text, 1, 4)
          Month_Date = Mid(.Cells(i, 29).Text, 5, 2)
        .Cells(i, 35) = DateSerial(Year_Date, Month_Date, 1)
        .Cells(i, 35).NumberFormat = "mm-yyyy"
  End If
Next i
End With

End Sub

job75 · 19 Juillet 2018

Re,

Plus simple et plus logique :

Code:

        If x <> "" And t(i, 7) Like "000000####*" Then _
            t(i, 7) = Mid(x, 5, 2) & "/" & Left(x, 4)

Fichier (2).

A+

Aimedija · 27 Juillet 2018

Bonjour le forum,
Bonjour le fil,

Aprés avoir fais pas mal d'essai avec des fichiers différents, la solution du poste 27 proposé par Job 75 est celle que j'ai retenue.

Merci à toi Job 75,
Merci Modeste Geedee,
Merci jean-Marie,

Bien à vous,

VBA excel extraire le mois et l'année d'une date au format standard

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

Discussions similaires