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

A

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: 61
Dernière édition:
Trier par date Trier par votes
job75

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.
 
Vote positif 0 Vote négatif
job75

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
Vote positif 0 Vote négatif
job75

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:
Vote positif 0 Vote négatif
A

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.
 
Vote positif 0 Vote négatif
A

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
Vote positif 0 Vote négatif
ChTi160

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:
Vote positif 0 Vote négatif
job75

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
Vote positif 0 Vote négatif
Modeste geedee

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
 
Vote positif 0 Vote négatif

Discussions similaires

T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
598
laurent950
laurent950
Chaton77
  • Résolu(e)
Microsoft 365 En VBA : Extraire le mois d'une date d'un tableau
Réponses
7
Affichages
328
Chaton77
Chaton77
A
  • Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
138
patricktoulon
patricktoulon
G
  • Résolu(e)
XL 2021 VBA dates au mauvais format
Réponses
5
Affichages
250
vgendron
vgendron
G
  • Question
XL 2016 Extraire des données d'un pdf et les copier dans excel
2
Réponses
17
Affichages
822
gali2
G
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
1 K
Dranreb
Dranreb
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
372
CathyLD
C
N
  • Résolu(e)
Microsoft 365 Mettre la 4ème colonne d'une ListBox au format [h]:mm
3 4 5
Réponses
68
Affichages
1 K
NONO14
N
F
  • Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
302
Oneida
Oneida
G
  • Question
Microsoft 365 Avoir des classeurs maitres et les procédures dans un autre classeur.
2
Réponses
18
Affichages
1 K
GClaire
G

Membres actuellement en ligne

7 membres et 69 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
315 111
Messages
2 116 340
Membres
112 720
dernier inscrit
henri marc michel