VBA possible décomposition des dates

Bonjour à tous,

J'aimerai savoir si il est possible en VBA d'écrire un code qui permet de décomposer les dates:

ex: 28/12/2019 03/01/2020

La décomposition se ferait comme ceci dans un tableau:

28/12/2019 au 31/12/2019

01/01/2020 au 03/01/2020

Ci joint un fichier pour mieux comprendre l'exemple.

Pouvez-vous m'aider et me donner des conseils pour créer ce code?

Merci pour votre aide

Cdt.

Fa.

30test.xlsx (10.93 Ko)

Bonjour,

Un essai ...

ric

Slt Fanini,

Slt ric,

un autre test

26test-fanini.xlsm (22.72 Ko)

Bonjour,

Un grand merci pour votre aide

Par contre impossible d'appliquer la macro dans mes fichiers...

Pouvez-vous jeter un coup d'œil afin de me dire où est la coquille?

Merci beaucoup,

Fa.

5fichier-test.xlsm (92.40 Ko)

Bonjour,

Un essai ...

Remarque qu'en C6, j'ai changé l'année pour que le code s'exécute (pour le test).

Aussi, je n'insère plus une ligne entière, mais seulement des cellules de A à D pour ne pas déranger les autres informations à droite de la colonne D.

ric

Bonjour Ric,

Le code fonctionne très bien par contre quand il n'y a pas de changement d'année cela ne fonctionne pas...et ça m'embête car j'ai également des dates sans changement d'année

Exemple: du 25/01/2020 au 02/02/2020 => la décomposition ne se fait pas

Est ce que cela est possible de faire la décomposition en fonction des mois et des années?

Un grand merci pour ton aide, je sais que je demande beaucoup d'aide...

Fa.

Slt,

regarde mon fichier en haut et utilise cette macro

Sub separer_annees()
    Dim I As Integer
    Dim lastrow As Integer
    Dim wf As WorksheetFunction

    Set wf = Application.WorksheetFunction

    lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

    For I = lastrow To 1 Step -1
        a = ActiveSheet.Range("B" & I).Value
        b = ActiveSheet.Range("C" & I).Value
        diff = (Year(b) - Year(a)) * 12 + Month(b) - Month(a)
        If diff > 0 Then
            Range("C" & I).Value = wf.EoMonth(a, 0)

            For k = 1 To diff
                Rows(I + k).Resize(1).Insert
                Range("A" & I + k).Value = Range("A" & I + k - 1).Value
                Range("B" & I + k).Value = Range("C" & I + k - 1).Value + 1
                If k <> diff Then
                    Range("C" & I + k).Value = wf.EoMonth(Range("B" & I + k).Value, 0)
                Else
                    Range("C" & I + k).Value = b
                End If
            Next k
        End If
    Next I
End Sub

Merci M3ellem1,

Par contre quand j'applique la macro j'ai cette erreur qui apparaît "incompatibilité de type", qu'est ce que cela veut dire?

Merci pour ton retour.

Fa.

Bonjour à tous,

... Est ce que cela est possible de faire la décomposition en fonction des mois et des années? ...

Huummm!!!! Si j'avais su ...

ric

Re,

essaie comme ca

Sub separer_annees()
    Dim I As Integer
    Dim lastrow As Integer
    Dim wf As WorksheetFunction

    Set wf = Application.WorksheetFunction

    lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

    For I = lastrow To 2 Step -1
        a = ActiveSheet.Range("B" & I).Value
        b = ActiveSheet.Range("C" & I).Value
        diff = (Year(b) - Year(a)) * 12 + Month(b) - Month(a)
        If diff > 0 Then
            Range("C" & I).Value = wf.EoMonth(a, 0)

            For k = 1 To diff
                Rows(I + k).Resize(1).Insert
                Range("A" & I + k).Value = Range("A" & I + k - 1).Value
                Range("B" & I + k).Value = Range("C" & I + k - 1).Value + 1
                If k <> diff Then
                    Range("C" & I + k).Value = wf.EoMonth(Range("B" & I + k).Value, 0)
                Else
                    Range("C" & I + k).Value = b
                End If
            Next k
        End If
    Next I
End Sub

Bonjour à tous,

@m3ellem1 ... ton code semble bien fonctionner à une exception près ... Il insère des lignes entières. Cela dérange les autres colonnes de H à S, lesquelles subissent elles aussi l'insertion de lignes.

Reste à savoir si cela convient à Fanini_excel ... zou pas.

ric

Slt ric,

voilà c'est réglé

Bonjour à tous,

Désolé d'être un peu téteux, mais il faut insérer des lignes de A à D et non de A à C, sinon la note "En attente" du client F ne suit pas.

Range("A" & I + k & ":D" & I + k).Insert Shift:=xlDown

Après ce petit changement, c'est impeccable à première vue.

Attendons le verdict de Fanini_excel.

ric

Désolé d'être un peu téteux, mais il faut insérer des lignes de A à D et non de A à C, sinon la note "En attente" du client F ne suit pas.

Range("A" & I + k & ":D" & I + k).Insert Shift:=xlDown

Bien vu!

J'ai actualisé le fichier et j'ai ajouté aussi cette ligne pour récupérer Statut pour rapport

Range("D" & I + k).Value = Range("D" & I + k - 1).Value

vous êtes au top!

je vais regarder la nouvelle version

super, ça marche nickel.

C'est exactement ce que je souhaitais. Il me reste à l'adapter à mon doc.

Encore merci

Fa.

Bonjour,

De la part de m3ellem1 et de la mienne ...

ric

Bonjour,

J'ai encore une question

Je souhaiter exécuter 2 macros via une seule macro générale.

Sub general() 'general Macro'

    selectioncp 'appel macro module 8'
    Feuil9.Cmd_Seperer_annees_Click 'appel macro feuille 9'

End Sub

La deuxième macro Feuil9.Cmd_Seperer_annees_Click ne fonctionne pas. Est ce que je dois la mettre dans un module plutôt que la relier à une feuille?

Merci pour votre aide

Fa.

Bonjour,

Il y a deux choses ...

1-

Sub general() 'general Macro'

    Call Module8.selectioncp 'appel macro module 8'
    Call Feuil9.Cmd_Seperer_annees_Click 'appel macro feuille 9'
End Sub

2- En appelant la macro d'ailleurs, ce n'est pas forcément la bonne feuille qui est sélectionnée, il faut donc le faire dans le code ...

Au début de la macro Cmd_Seperer_annees_Click, juste après les Dim, ajoute la sélection de la feuille ainsi Feuil9.Activate.

Ça devrait fonctionner.

Si tu ne veux plus le bouton Cmd_Seperer_annees_Click, tu pourrais renommer cette macro pour Seperer_annees

ric

ça marche parfaitement, merci pour les conseils

Rechercher des sujets similaires à "vba possible decomposition dates"