Autres Insertion nombre de lignes variable - VBA

lilidxb

XLDnaute Nouveau
Bonjour à tous,

J'ai besoin d'un coup de main VBA, je galère depuis des jours dessus. Je vous explique mon problème. Je gère une base donne de projets. Les projets sont gérés en 6 phases. Dans ma base de donne chaque projet contient donc 6 ligne pour chaque phase avec semaine de début et semaine de fin. Il arrive que l'on ait des interruptions de projets. J'aimerai, en fonction de la date d'interruption, insérer un nombre de ligne correspondant aux semaines d'interruption. Je vous joint un fichier pour illustrer mes propos.

Je m'explique, mon projet s'interrompt de la semaine 3 à 6, colonne B je trouve mon projet, colonne M je trouve ma ligne concernée en trouvant la semaine strictement supérieure à 3 et inferieure ou égale à 6. J'arrive à identifier ces éléments avec des couleurs mais impossible d'insérer le nombre de ligne voulu.

Les lignes insérées reprendraient les éléments d’information du projet mais au lieu du nom de la phase la mention = « Project interruption » ainsi que le numéro de la semaine dans la colonne M. Si le projet s’interrompt de la semaine 3 à 6, il faudrait 4 lignes avec leur numéro de semaine en colonne M.

Ligne 1 «Project interruption » 3
Ligne 2 «Project interruption » 4
Ligne 3 «Project interruption » 5
Ligne 4 «Project interruption » 6


J’espère que c’et assez claire pour que vous y apportez vos précieuse lumières !

Je vous joins le code entier:

Code:
Sub interruption_projet()
Dim premierecellule As Integer: Dim dernierecellule As Integer
Dim semainedebut As Integer: Dim semainefin As Integer
Dim Mon_projet As String

Mon_projet = Range("T2").Value
semainedebut = 3
semainefin = 6
nbdeligneainserer = 4

Dim bonnecolonne As Range

Set bonnecolonne = Range("B2:B1000").Find(Mon_projet)
I = bonnecolonne.Row

Premiereligne = I

derniereligne = I + 1

Do While Range("B" & derniereligne) = Mon_projet And Range("B" & Premiereligne) = Mon_projet And Range("B" & derniereligne) = Range("B" & Premiereligne)

    derniereligne = derniereligne + 1
    
Loop

Range(Cells(Premiereligne, 1), Cells(derniereligne - 1, 17)).Select
Selection.Interior.ColorIndex = 17

Dim Ma_plage As Range
Dim Cell As Range
Dim macell As Integer

Set Ma_plage = Worksheets("DP").Range(Cells(Premiereligne, 13), Cells(derniereligne - 1, 13))

For Each Cell In Ma_plage
    
                If Cell.Value > semainedebut And Cell.Value <= semainefin Then
                Cell.EntireRow.Interior.ColorIndex = 27
                Cell.Interior.ColorIndex = 4
                Rows(Cell.Row + nbdeligneainserer).insertshifht xlDown
                        
                End If
              
        Next Cell
End Sub


Merci par avance et bon confinement !
 

Pièces jointes

  • Project_interruption.xlsm
    237.5 KB · Affichages: 6
Solution
j'ai rajouté le "remplissage" des lignes vides
VB:
Sub interruption()
Dim Projet As String
Dim phase As String
Dim TempsInterruption As Long
TempsInterruption = 4 'nombre de lignes qui seront insérées
phase = "Phase 3" 'phase à partir de laquelle le projet est interrompu
With ActiveSheet
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne de la feuille
    Projet = .Range("T2") 'nom du projet interrompu en T2
    Set ilestla = .Range("B:B").Find(Projet) 'on cherche la première ligne du projet en colonne B
    If Not ilestla Is Nothing Then
        Set ici = .Range("K" & ilestla.Row).Resize(fin - ilestla.Row, 1).Find(phase) 'on cherche la phase 3 du projet
        If Not ici Is Nothing Then
            .Rows(ici.Row +...

vgendron

XLDnaute Barbatruc
Bonjour
Je n'ai pas compris la logique...
un projet = 6 phases donc 6 lignes
chaque phase a un début (colonne L) et une fin (colonne P) ===> comment se fait il que des débuts soient après la fin..?? nouvelle théorie de la relativité?
ex: phase 1 du projet H11111: commence le 03/03/2020 et finit le 15/02/2020 ??
l'interruption.. comment est elle définie? comment sait on quel projet est interrompu et combien de temps?

le but est d'ajouter autant de lignes projet que de semaines d'interruption??

dans ton code: il faut corriger la syntaxe d'insertion de ligne
VB:
Rows(Cell.Row + nbdeligneainserer).Insert shift:=xlDown
 

lilidxb

XLDnaute Nouveau
onjour! Merci pour ton retour,

Non pour le projet H11111, J'ai rectifie il s'agissait d'une erreur en effet la date de début est toujours avant en « L » puis la de fin en « P ». J’ai modifié le fichier avant de l’envoyer pour enlever les vraies data j’ai dû mixer des infos, sorry !


Je viens d'essayer votre code mais cela m'ajoute une ligne 4 lignes plus bas que l'endroit désirée. J'ai essayé plusieurs formulation possible mais je fini souvent à insérer 63000 lignes et Excel plante...
 

Pièces jointes

  • Project_interruption.xlsm
    235 KB · Affichages: 2

lilidxb

XLDnaute Nouveau
J'utilise sur une autre page un userform qui selectionne le projet, la semaine de debut et la semaine de fin. Sur mon autre page il met a jour mon planning de projet en mettant a 0% la charge d'activite du projet de la semaine de debut jusqu'a la semaine de fin.
C'est justement lorsque je valide ce userform que j'aimerai dans cette page ici presente inserer les lignes correspondantes a l'interruption. Je sais pas si c'est clair

Merci bcp!

(desolee pour les fautes j'ai un clavier anglais)
 

vgendron

XLDnaute Barbatruc
voir code ci dessous avec commentaires
tu as juste à adapter et completer
VB:
Sub interruption()
Dim Projet As String
Dim phase As String
Dim TempsInterruption As Long
TempsInterruption = 4 'nombre de lignes qui seront insérées
phase = "Phase 3" 'phase à partir de laquelle le projet est interrompu
With ActiveSheet
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne de la feuille
    Projet = .Range("T2") 'nom du projet interrompu en T2
    Set ilestla = .Range("B:B").Find(Projet) 'on cherche la première ligne du projet en colonne B
    If Not ilestla Is Nothing Then
        Set ici = .Range("K" & ilestla.Row).Resize(fin - ilestla.Row, 1).Find(phase) 'on cherche la phase 3 du projet
        If Not ici Is Nothing Then
            .Rows(ici.Row + 1).Resize(TempsInterruption).Insert shift:=xlDown 'on insère 4 lignes sous la phase
        End If
    End If
End With
End Sub
 

vgendron

XLDnaute Barbatruc
j'ai rajouté le "remplissage" des lignes vides
VB:
Sub interruption()
Dim Projet As String
Dim phase As String
Dim TempsInterruption As Long
TempsInterruption = 4 'nombre de lignes qui seront insérées
phase = "Phase 3" 'phase à partir de laquelle le projet est interrompu
With ActiveSheet
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne de la feuille
    Projet = .Range("T2") 'nom du projet interrompu en T2
    Set ilestla = .Range("B:B").Find(Projet) 'on cherche la première ligne du projet en colonne B
    If Not ilestla Is Nothing Then
        Set ici = .Range("K" & ilestla.Row).Resize(fin - ilestla.Row, 1).Find(phase) 'on cherche la phase 3 du projet
        If Not ici Is Nothing Then
            .Rows(ici.Row + 1).Resize(TempsInterruption).Insert shift:=xlDown 'on insère 4 lignes sous la phase
            .Rows(ici.Row).Resize(TempsInterruption + 1).FillDown 'on recopie les info sur les lignes insérées
            .Range("K" & ici.Row + 1).Resize(TempsInterruption) = "Interruption " & phase 'inscription "Interruption dans la colonne K
        End If
    End If
End With
End Sub
 

lilidxb

XLDnaute Nouveau
Merci bcp c'est genial et fonctionne tres bien si je recherche par phase. Cependant je dois trouver la bonne ligne en la semaine (colonne "M") trouvant celle qui tombe entre ma semaine de debut et celle de fin. Car lorsque j'utilise mon userform pour selectionner mon projet a interrompre je n'ai pas l'info de la phase.
 

Discussions similaires

Réponses
1
Affichages
119
Réponses
0
Affichages
83
Réponses
3
Affichages
457

Statistiques des forums

Discussions
311 721
Messages
2 081 928
Membres
101 842
dernier inscrit
seb0390