découper en jours

sangarmatha

XLDnaute Junior
Bonjour,

Suite à une extraction de SAP, j'obtiens une date de début et un nombre d'heures pour les congés par exemple.
J'aimerai découper ce résultat en une liste de date sur la base de 10h/J (si possible par formule) mais je sèche!!!
Exemple ci-joint dans excel
Merci d'avance de votre aide
 

Pièces jointes

  • liste.xlsx
    10.9 KB · Affichages: 24

Jocelyn

XLDnaute Barbatruc
Bonjour le Forum,
Bonjour sangarmatha, Chris :),

Hum hum faire ce que tu demande de façon verticale je ne vois pas trop par contre le faire horizontalement sur chaque ligne de l'extraction en considérant la première date comme déjà inscrite en essai

Cordialement
 

Pièces jointes

  • liste.xlsx
    12.3 KB · Affichages: 25

job75

XLDnaute Barbatruc
Bonjour sangarmatha, chris, Jocelyn,

Sinon voici 2 méthodes très classiques qui fonctionnent sous toute version Excel.

1) Fichier (1) si le tableau des résultats n'est pas trop grand (quelques centaines de lignes) :
Code:
Sub Objectif()
Dim dest As Range, i&
Set dest = [J2] '1er titre de la plage de destination
Application.ScreenUpdating = False
dest(2).Resize(Rows.Count - dest.Row, 7).Delete xlUp 'RAZ
With [A1].CurrentRegion
    For i = 3 To .Rows.Count
        Set dest = dest(2)
        .Rows(i).Copy dest
        While dest(1, 7) > 10
            dest.Resize(, 7).Copy dest(2)
            dest(2, 7) = dest(1, 7) - 10: dest(1, 7) = 10
            dest(2, 6) = dest(1, 6) + 1
            Set dest = dest(2)
        Wend
    Next
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
L'intérêt de cette méthode c'est que les formats sont copiés.

2) Fichier (1 bis) dans tous les cas :
Code:
Sub Objectif()
Dim dest As Range, t, i&, n&, resu(), j%
Set dest = [J2] '1er titre de la plage de destination
t = [A1].CurrentRegion.Offset(2).Resize(, 7)
For i = 1 To UBound(t) - 2
    n = n + 1
    ReDim Preserve resu(1 To 7, 1 To n)
    For j = 1 To 7: resu(j, n) = t(i, j): Next
    While resu(7, n) > 10
        n = n + 1
        ReDim Preserve resu(1 To 7, 1 To n)
        For j = 1 To 7: resu(j, n) = resu(j, n - 1): Next
        resu(7, n) = resu(7, n - 1) - 10: resu(7, n - 1) = 10
        resu(6, n) = resu(6, n - 1) + 1
    Wend
Next
'---transposition---
If n Then
    ReDim t(1 To n, 1 To 7)
    For i = 1 To n
        For j = 1 To 7
            t(i, j) = resu(j, i)
    Next j, i
    If FilterMode Then ShowAllData 'si la feuille est filtrée
    dest(2).Resize(n, 7) = t
End If
'---RAZ sous le tableau---
dest(2).Offset(n).Resize(Rows.Count - n - dest.Row, 7).ClearContents
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
Cette méthode est beaucoup plus rapide grâce aux tableaux VBA.

A+
 

Pièces jointes

  • liste(1).xlsm
    23.9 KB · Affichages: 22
  • liste(1 bis).xlsm
    23.8 KB · Affichages: 18

Discussions similaires

Réponses
14
Affichages
532

Statistiques des forums

Discussions
312 215
Messages
2 086 319
Membres
103 177
dernier inscrit
grizly