Incrémente un tableau avec vba FOR et TO

jflegros

XLDnaute Nouveau
Bonjour,
Je viens vous voir car j'ai besoin d'aide pour alimenter un fihier en fonction d'un tableau récapitulatif.
J'ai commencé VBA avec FOR ... TO ... mais sans succès.
Je suis preneur de tous autres idées...
Ci-joint le fichier

Merci d'avance pour l'aide que vous pourrez m'apporter
 

Pièces jointes

  • PLANNING TEST.xlsx
    87.5 KB · Affichages: 36

JBARBE

XLDnaute Barbatruc
Re : Incrémente un tableau avec vba FOR et TO

Bonsoir à tous,

En cliquant sur le bouton GO les mois de Janvier et Février se font !

En cellule A1 il y a la somme de NB de Janvier ( à ne pas supprimer)

En cellule A2 il y a la somme de NB de Février ( à ne pas supprimer)

Pour les autres mois, il faut adapter les lignes et les colonnes correspondantes et faire des autres sommes pour les mois !

En gras les rectifs a faire selon mois ( ici janvier )

Sub trie_lundi()
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
With Sheets("PDS")
If .Range("B17") = 0 Then """" si la cellule B17 = 0 alors cellules suivantes effacées
Range("C14:D163") = ""
Range("F14:G163") = ""
Exit Sub
End If
Range("C14:D163") = "" '''' cellules effacées
Range("F14:G163") = "" '''' cellules effacées
For i = 4 To 16
If .Cells(i, 11) = "" Then Exit Sub
.Cells(i, 11).Copy
Sheets("Planning").Cells(14 + Range("A1"), 3).Select '''''' 14 Premiere Ligne et Range("A1")=somme du Lundi ( Range("A2") étant celle du Mardi
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Cells(i, 12).Copy
Sheets("Planning").Cells(14 + Range("A1"), 4).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If .Cells(i, 2) = "" Then "" 2 correspondant à la colonne B ( Janvier de PDS)
Sheets("Planning").Cells(14 + Range("A1"), 6) = 1
Else
Sheets("Planning").Cells(14 + Range("A1"), 6) = .Cells(i, 2) "" 2 correspondant à la colonne B ( Janvier de PDS)
End If
For j = 1 To .Cells(i, 2) - 1 "" 2 correspondant à la colonne B ( Janvier de PDS)
Sheets("Planning").Cells(j + 13 + Range("A1") - ActiveCell.Offset(0, 2) + 1, 3) = Sheets("Planning").Cells(j + 13 + Range("A1") - ActiveCell.Offset(0, 2), 3) '''' 13 une ligne en dessous de la premiere ligne
Sheets("Planning").Cells(j + 13 + Range("A1") - ActiveCell.Offset(0, 2) + 1, 4) = Sheets("Planning").Cells(j + 13 + Range("A1") - ActiveCell.Offset(0, 2), 4)
Sheets("Planning").Cells(j + 13 + Range("A1") - ActiveCell.Offset(0, 2), 7) = j
Sheets("Planning").Cells(j + 13 + Range("A1") - ActiveCell.Offset(0, 2) + 1, 7) = j + 1
Next j
Application.CutCopyMode = False
Next i
Range("C14:G163").Select
With Selection.Font
.Name = "Arial"
.Size = 12
.Color = 255
End With
End With
Application.ScreenUpdating = True
End Sub


bonne nuit !
 

Pièces jointes

  • PLANNING TEST.xlsm
    105.1 KB · Affichages: 25
Dernière édition:

JBARBE

XLDnaute Barbatruc
Re : Incrémente un tableau avec vba FOR et TO

Bonjour à tous,

Bon, le fichier a été fait du lundi au dimanche !

Dans la feuille PDS, il y a des données du mercredi au dimanche que j'ai saisie pour tester !

Il est important de respecter les colonnes et les lignes des 2 feuilles !

De plus, dans la feuille PDS il y avait des cellules vides en face des heures , j'ai mis 1 afin de ne pas confondre avec les cellules vides des totaux !

Si le total des heures du jour dans la feuille PDS = 0 alors il n'y a pas de calcul

bonne journée !
 

Pièces jointes

  • PLANNING TEST.xlsm
    107.4 KB · Affichages: 25
Dernière édition:

CISCO

XLDnaute Barbatruc
Re : Incrémente un tableau avec vba FOR et TO

Bonjour à tous, bonjour JBARBE

Puisque c'est fait, ci-joint une possibilité, avec une macro qui ne remplie que les colonnes C et D,
Code:
Sub recopier()
Dim col As Integer, lig As Integer
Dim a As Integer, b As Integer, c As Integer, i As Integer, j As Byte, k As Byte


Dim positionjour As Integer
Dim jour(1 To 7) As String

jour(1) = "LUNDI"
jour(2) = "MARDI"
jour(3) = "MERCREDI"
jour(4) = "JEUDI"
jour(5) = "VENDREDI"
jour(6) = "SAMEDI"
jour(7) = "DIMANCHE"

'NETTOYAGE
For j = 0 To 6 '7  jours
For k = 0 To 5 '6 feuilles par jour
Sheets("Planning").Range("C" & 14 + (k * 30) + (j * 186) & ":D" & 38 + (k * 30) + (j * 186)).ClearContents
Next k
Next j



'ITERATION SUR LES COLONNES du tableau PDS!B4:H16
For col = 2 To 8
    'INITIALISATION A CHAQUE CHANGEMENT DE COLONNE
    'valeur de la dernière itération du jour en cours (remise à zéro puisque chgt de colonne = chgt de jour)
    b = 0
    'n° de la ligne du haut du tableau du jour en cours
    positionjour = Worksheets("Planning").Range("B:B").Find(jour(col - 1)).Row

        'ITERATION SUR LES LIGNES du tableau PDS!B4:H16 pour parcourir toutes les valeurs du jour en cours
        For lig = 4 To 16
        c = Sheets("PDS").Cells(lig, col) 'nombre de lignes à coller lu dans le tableau PDS!A4:A16
        a = b + 1 'valeur de la 1ère itération = dernière itération du groupe précédent + 1
        b = c + b 'valeur de la dernière itération = dernière itération du groupe précédent + nbre de lignes à coller
                For i = a To b
                'Positionjour pour être en haut du tableau du jour concerné
                '+ 2 pour se positionner au bon endroit
                '+ i pour se décaller vers le bas au fur et à mesure, en fonction du nbre de lignes à coller
                '+ 5 * Int((i - 0.1) / 25)) pour passer d'une feuille à la suivante, toutes les 25 itérations, c-à-d pour sauter 5 lignes
                'Left... pour ne garder que la partie gauche de la période lue dans PDS!A4:A16
                'Right... pour ne garder que la partie droite de la période lue dans PDS!A4:A16
                Sheets("Planning").Range("C" & positionjour + 2 + i + 5 * Int((i - 0.1) / 25)) = Left(Sheets("PDS").Range("A" & lig), InStr(Sheets("PDS").Range("A" & lig), "-"))
                Sheets("Planning").Range("D" & positionjour + 2 + i + 5 * Int((i - 0.1) / 25)) = Right(Sheets("PDS").Range("A" & lig), Len(Sheets("PDS").Range("A" & lig)) - InStr(Sheets("PDS").Range("A" & lig), "-"))
                Next i
        Next lig
Next col

End Sub
et aussi des formules dans les colonnes F et G, et les noms plagelundi, plagemardi, plagemercredi et ainsi de suite dans le gestionnaire de noms. A tester davantage pour voir si c'est vraiment polyvalent.

@ plus
 

Pièces jointes

  • PLANNING TEST.xlsm
    121.2 KB · Affichages: 24
Dernière édition:

CISCO

XLDnaute Barbatruc
Re : Incrémente un tableau avec vba FOR et TO

Rebonjour

Pour que ma proposition fonctionne, et plus précisément pour que le find de la ligne
Code:
positionjour = Worksheets("Planning").Range("B:B").Find(jour(col - 1)).Row
passe, il faut défusionner les cellules contenant le premier LUNDI, le premier MARDI, le premier MERCREDI et ainsi de suite dans la feuille Planning, colonnes B:C. Dans la pratique, j'ai défusionné dans la dernière pièce jointe toutes les cellules contenant un nom de jour.

@ plus
 

CISCO

XLDnaute Barbatruc
Re : Incrémente un tableau avec vba FOR et TO

Bonjour

On peut faire sans le tableau jour() puisque les noms de jour sont aussi dans la plage PDS!B3:H3. Cf. en pièce jointe.

@ plus
 

Pièces jointes

  • PLANNING TEST2.xlsm
    123.3 KB · Affichages: 31

Discussions similaires

Statistiques des forums

Discussions
312 758
Messages
2 091 788
Membres
105 074
dernier inscrit
JPATOUNE