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

Aimedija

XLDnaute Nouveau
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
 

Pièces jointes

  • Exemple date.xlsm
    54.7 KB · Affichages: 60
Dernière édition:

job75

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Exemple date 2(1).xlsm
    233.1 KB · Affichages: 21

job75

XLDnaute Barbatruc
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+
 
Dernière édition:

Aimedija

XLDnaute Nouveau
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.
 

Aimedija

XLDnaute Nouveau
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
 

Pièces jointes

  • Exemple date VBA 2.xlsm
    37.2 KB · Affichages: 27

ChTi160

XLDnaute Barbatruc
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
 

Pièces jointes

  • Exemple date VBA 2 Chti160.xlsm
    33.2 KB · Affichages: 27
Dernière édition:

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Exemple date VBA 2(1).xlsm
    37.2 KB · Affichages: 17

Modeste geedee

XLDnaute Barbatruc
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
 

Discussions similaires

Réponses
1
Affichages
119
Réponses
5
Affichages
124
Réponses
0
Affichages
83