[RESOLU] Mettre mois année d'une date dans variable

[cathodique]

Bonjour,

Je voudrais récupérer le mois et l'année d'une série de dates (colonne A), sans doublons dans une variable.
Afin de l'utiliser dans une boucle (ex: créer et nommer feuille mois-année).

En vous remerciant par avance.

 

[eriiic]

Bonjour,

Sub moisAnnee()
    Dim datas, dict, lig As Long, k
    datas = [A2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1).Value
    Set dict = CreateObject("Scripting.Dictionary")
    For lig = 1 To UBound(datas)
        If IsDate(datas(lig, 1)) Then
            k = Year(datas(lig, 1)) & "-" & Format(Month(datas(lig, 1)), "00")
            dict(k) = k
        End If
    Next lig
    For Each k In dict.keys
        Debug.Print k
    Next k
    Set dict = Nothing
End Sub

eric

 

[cathodique]

Bonjour Eric,

Je te remercie beaucoup pour ton aide, j'apprécie. Stp que signifie le "00" à la fin de la ligne de code ci-dessous:

k = Year(datas(lig, 1)) & "-" & Format(Month(datas(lig, 1)), "00")

De mon côté, je suis parvenu au même résultat que le tien. Par contre, comme il s'agit de date j'utilise .Value2. C'est une astuce donnée par Laetitia90, reprise sur le site de Boisgontier.

Sub Ventiler()
    Dim Ddate As Object, base(), i As Long, cle, oSheet as worksheet
     Set oSheet = ThisWorkbook.Worksheets("export")
    Set Ddate = CreateObject("Scripting.Dictionary")
    dl = Range("a" & Rows.Count).End(xlUp).Row

    base = oSheet.Range("A2:A" & dl).Value2
    For i = LBound(base, 1) To UBound(base, 1)
        If Not Ddate.exists(Month(base(i, 1)) & "|" & Year(base(i, 1))) Then Ddate(Month(base(i, 1)) & "|" & Year(base(i, 1))) = ""
    Next i
   
    For Each cle In Ddate.keys
        Debug.Print cle
    Next cle
End Sub

Très gentil de ta part
Bonne journée.

 

[ChTi160]

Bonjour Cath
Bonjour le Fil(Eric) ,Le Forum
le "00" c'est le format qui est donné au Mois , c'est a Dire : Month(datas(lig, 1)) donne "1" ça le transforme en "01" pour Janvier ,"02" pour Février etc
pas utile dans ton cas je pense Lol
Bonne journée
Amicalement
jean marie

 

[cathodique]

ChTi160 bonjour,

OK, enregistrer. J'ai compris en effet dans mon cas j'en ai pas besoin.
Merci beaucoup.
Bonne journée.

 

[kingfadhel]

Bonjour, à tous
Une solution avec:

• insertion d'une colonne transitoire
• récupération des dates
• suppression de la colonne transitoire

Edit: Désolé je n'ai pas actualiser

 

[ChTi160]

Re
Un test
avec ceux ci dans un module Standard

Option Explicit
Dim Ws As Object
Dim dL As Long
Dim ShtName As String
Sub Ventiler()
    Dim Ddate As Object, base, i As Long, cle, oSheet As Worksheet
    Application.ScreenUpdating = False  
     Set oSheet = ThisWorkbook.Worksheets("export")
    Set Ddate = CreateObject("Scripting.Dictionary")
With oSheet
      dL = .Range("a" & .Rows.Count).End(xlUp).Row
    base = .Range("A2:A" & dL).Value2
End With
    For i = LBound(base, 1) To UBound(base, 1)
        If Not Ddate.exists(Month(base(i, 1)) & "|" & Year(base(i, 1))) Then
           Ddate(Month(base(i, 1)) & "|" & Year(base(i, 1))) = ""
           ShtName = Format(base(i, 1), "mm-yyyy")
           Set Ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
          With Ws
              .Name = ShtName
          End With
        End If
    Next i
    Set base = Nothing
Application.ScreenUpdating = True
End Sub

pas de gestion des Feuilles existantes , pour le format des Noms des Feuilles , j'ai Mis "mm-yyyy" Lol
mettre

ShtName = Format(base(i, 1), "mmmm yyyy")

'pour répondre à la demande lol
ne sachant pas comment ca doit fonctionner Lol
Bonne Journée
Amicalement
Jeanmarie

 

[kingfadhel]

Re,
Solution complète testée chez moi, EXCEL 2016

Sub GetUniques()
Dim d As Object, c As Variant, i As Long, lr As Long
Set d = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, 1).End(xlUp).Row
'Ajout d'une colonne transitoire à droite du tableau ici  B
[B2].FormulaR1C1 = _
        "=CHOOSE(MONTH([@[Date commande]]),""Janvier "",""Février "",""Mars "",""Avril "",""Mai "",""Juin "",""Juillet "",""Août "",""Septembre "",""Octobre "",""Novembre "", ""Décembre "") & YEAR([@[Date commande]])"

c = Range("b2:b" & lr)
For i = 1 To UBound(c, 1)
d(c(i, 1)) = 1
Next i
'transfert des dates sans doublons dans la colonne E à modifier selon le besoin
Range("e2").Resize(d.Count) = Application.Transpose(d.keys)

'Suppression de la colonne transitoire ici B à modifier
Columns("B:B").Delete Shift:=xlToLeft

'CREATION DES FEUILLES
'd2 à changer par l'adresse de la première ligne contenant les dates
datas = [d2].Resize(Cells(Rows.Count, 4).End(xlUp).Row - 1).Value
    Set dict = CreateObject("Scripting.Dictionary")
    For lig = LBound(datas) To UBound(datas)
        ShtName = datas(lig, 1)
        Set Ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        With Ws
            .Name = ShtName
        End With
    Next lig
End Sub

 

[cathodique]

@kingfadhel : ton idée me plaît bien, car c'est ainsi que je voudrais nommée les feuilles, le mois en lettre et l'année. Merci beaucoup.

@ChTi160 : Ton code est super pour créer et nommer les feuilles. Merci beaucoup.

Je constate que mon sujet vous intéresse. Je vous mets au parfum. C'est pour aider quelqu'un mais je ne maîtrise pas parfaitement la manipulation des tableaux. Alors, d'une pierre 2 coups, je me familiarise et essaie d'aider. D'autant plus que je n'ai pas beaucoup de temps ces jours-ci.

Voilà, l'objectif est d'extraire d'une bd (à supposer qu'elle ait 12 colonnes) les données chacune dans son onglet. ex: données de mai 2010 sur onglet nommé 'mai-2010'.

Très sympa.
Mes remerciements anticipés.

Désolé, pas vu je rédigeais mon message

 

[kingfadhel]

Re,
je crois que ça ressemble à la discussion suivante:
un coup d’œil ici
et plus précisément la #5
@plus

 

[ChTi160]

Re
Bonjour à Kingfadhel
voir modification
pour le nom des feuilles mettre dans la procédure :

ShtName = Format(base(i, 1), "mmmm yyyy")

une question tu ne crées ces feuilles et ne transfères les données qu'une seule fois ?
je regarde ton fichier
Bonne Journée
Amicalement
Jean marie

 

[cathodique]

Re,
je crois que ça ressemble à la discussion suivante:
un coup d’œil ici
et plus précisément la #5
@plus

Non, pas du tout. C'est pour un jeune de notre association 'les amis de l'école'. On aide aux devoirs. Merci beaucoup.

 

[cathodique]

une question tu ne crées ces feuilles et ne transfères les données qu'une seule fois ?

D'après ce que j'ai compris la feuille qui contient les données évolue, donc les feuilles sont supprimées avant de les recréer et y transférer les données.
Merci beaucoup, très gentil.

ps: je dois partir pour mon renouveler mon traitement.

@+

 

[kingfadhel]

Re,
Une solution à inserer à la fin de la procédure ventiler ou l'appeler avec Call

Sub Transfert()
For i = 2 To Range("a" & Rows.Count).End(xlUp).Row
K = Format(Month(Cells(i, 1)), "00")
L = Year(Cells(i, 1))
KL = K & "-" & L
Range("A" & i & ":L" & i).Copy
Sheets(KL).Activate
dL = Range("a" & Rows.Count).End(xlUp).Row + 1
Range("A" & dL).Select
ActiveSheet.Paste
Sheets("export").Activate
Next
End Sub

à plus @cathodique

 

[ChTi160]

Re dejà dans ta procédure tu emploies la variable "oSheet"
a toutes les Sauces Lol
pour définir la feuille Source puis chaque feuille du Classeur , au final elle aura pour valeur la dernière feuille du Classeur
déplace la ligne
Set oSheet = ThisWorkbook.Worksheets("export") 'après la Boucle

Sub Ventiler() 'code de ChTi160
    Dim Ddate As Object, base, i As Long, cle, oSheet As Worksheet
    Application.ScreenUpdating = False
   'd'ici
    Set Ddate = CreateObject("Scripting.Dictionary")
'supprimer feuilles
    For Each oSheet In Sheets
        If LCase(oSheet.Name) <> "export" Then
            Application.DisplayAlerts = False
            oSheet.Delete
            Application.DisplayAlerts = True
        End If
    Next
Set oSheet = ThisWorkbook.Worksheets("export") ' à La
With oSheet
      dL = .Range("a" & .Rows.Count).End(xlUp).Row
    base = .Range("A2:L" & dL).Value2 '**données de colA à colL
End With

je regarde cela Lol
Bonne journée
Amicalement
jean marie