Microsoft 365 Macro insérer des lignes en fonction du contenu d'une cellule

Guileo

XLDnaute Nouveau
Bonjour à tous,

Dans le cadre d'un projet perso, j'ai besoin d'une macro qui agit sur un tableau que j'obtiens avec un export de logiciel.

Le but est le suivant :
Si l'une des cases contient un remplissage "vert" alors il faut ajouter une colonne puis dans cette colonne renseigner l'information correspondante à la case verte.

J'ai expliqué en détail dans le fichier excel ci-joint.

J'ai essayée des choses mais je suis trop novice pour réussir ...

Pouvez-vous me donner votre avis de macro d'expert pour ce sujet :)

Très bonne journée à vous.
Guil
 

Pièces jointes

  • Test macro.xlsx
    21.5 KB · Affichages: 22

Rouge

XLDnaute Impliqué
Bonjour,

L'énoncé de votre problème n'est pas très clair, d'où sûrement le manque de réponses.
Vous écrivez:
-qu'il faut ajouter une colonne entre I et J si on trouve une cellule verte dans le tableau de AK à AP,
-idem pour la première cellule verte s'il y en a plusieurs sauf que vous ne précisez pas si c'est sur une même ligne ou sur l'ensemble du tableau de la plage AK à AP, et pour les autres cellules vertes on ajoute une ligne en fin de tableau .
Ce que je vois, c'est que dans tous les cas il faut insérer une colonne entre I et J, donc autant qu'elle soit créée d'emblée. De par cette insertion, la nouvelle colonne prendra la position de la colonne J et la colonne J actuelle passera en colonne K, ce qui décalera tout le reste d'un cran vers la droite et le tableau qui était en AK:AP se retrouvera en AL:AQ.

Questions:
-Lorsque tout sera réalisé comme vous le souhaitez que fait-on des cellules vertes, faut-il supprimer la couleur, ou bien cela sera écrasé par un nouvel import de données?
-Lors de votre prochain import de données, que faudra-t-il faire? Insérer encore une colonne supplémentaire?

Cdlt
 

Rouge

XLDnaute Impliqué
Votre macro modifiée
VB:
Sub Bouton1_Cliquer()
    Dim n As Long, Coul As Long, l As Long, k As Long
    Application.ScreenUpdating = False
    n = Range("CB1").Value
    Coul = Range("CB1").Interior.Color
    l = Range("CB2").Value
    k = n + l + 2
    For i = l To n + l
        If Range("AT" & i).Interior.Color = Coul Then
            Range("J" & k).Value = Range("AT3").Value
            Range("A" & k & ":AT" & k).Value = Range("A" & i & ":AT" & i).Value
            Range("AT" & k).Interior.Color = Coul
            k = k + 1
        End If
        If Range("AU" & i).Interior.Color = Coul Then
            Range("J" & k).Value = Range("AU3").Value
            Range("A" & k & ":AU" & k).Value = Range("A" & i & ":AU" & i).Value
            Range("AU" & k).Interior.Color = Coul
            k = k + 1
        End If
        If Range("AV" & i).Interior.Color = Coul Then
            Range("J" & k).Value = Range("AV3").Value
            Range("A" & k & ":AV" & k).Value = Range("A" & i & ":AV" & i).Value
            Range("AV" & k).Interior.Color = Coul
            k = k + 1
        End If
        If Range("AW" & i).Interior.Color = Coul Then
            Range("J" & k).Value = Range("AW3").Value
            Range("A" & k & ":AW" & k).Value = Range("A" & i & ":AW" & i).Value
            Range("AW" & k).Interior.Color = Coul
            k = k + 1
        End If
        If Range("AX" & i).Interior.Color = Coul Then
            Range("J" & k).Value = Range("AX3").Value
            Range("A" & k & ":AX" & k).Value = Range("A" & i & ":AX" & i).Value
            Range("AX" & k).Interior.Color = Coul
            k = k + 1
        End If
        If Range("AY" & i).Interior.Color = Coul Then
            Range("J" & k).Value = Range("AY3").Value
            Range("A" & k & ":AY" & k).Value = Range("A" & i & ":AY" & i).Value
            Range("AY" & k).Interior.Color = Coul
            k = k + 1
        End If
    Next
End Sub

Cdlt
 

soan

XLDnaute Barbatruc
Inactif
Bonjour Guileo, Rouge, job75,

ton fichier en retour ; fais Ctrl e ➯ travail effectué :

ça a ajouté 3 colonnes devant l'ancienne colonne J pour David, Louise, et Simon.

➯ maintenant, la colonne "Désignation" se retrouve en colonne M. 😊



code VBA de Module1 (49 lignes) :

VB:
Option Explicit

Const cf& = 5287936 'couleur de fond : vert foncé

Dim nci% 'n° col devant laquelle insérer 1 col ; au départ : J = 10
Dim ncv% 'n° colonne à vérifier ; au départ, pour la colonne AK : 37
Dim ncf As Byte 'nombre de colonnes faites ; au départ : 0 colonne
Dim dlg& 'dernière ligne utilisée ; ce sera selon la colonne A

Private Sub Job() 'pour traiter chaque colonne l'une après l'autre,
                  'à partir de la colonne cdL / ncv : AK / 37
  Dim k&, n&, i&
  For i = 7 To dlg
    If Cells(i, ncv).Interior.Color = cf Then
      n = n + 1 'nb de cellules de fond cf dans la colonne ncv
      If n = 1 Then 'pour la 1ère cellule de fond cf
        Columns(nci).Insert 2, 0: nci = nci + 1: ncv = ncv + 1
        k = nci - 1
        With Cells(4, k)
          .Borders(9).Color = 12566463: .Borders(9).LineStyle = 1
          With .Offset(-1).Resize(5)
            .Borders(10).Color = 12566463: .Borders(10).LineStyle = 1
            .Borders(7).Color = 12566463: .Borders(7).LineStyle = 1
          End With
          With .Offset(1).Resize(4).Borders(12)
            .Color = 12566463: .LineStyle = 1: .Weight = 1
          End With
          .Value = Cells(3, ncv)
        End With
      End If
      With Cells(i, k)
        .HorizontalAlignment = 4: .IndentLevel = 1
        .NumberFormat = "#,##0.0000;-#,##0.0000;"
        .Value = Cells(i, ncv)
      End With
    End If
  Next i
  ncf = ncf + 1: ncv = ncv + 1
End Sub

Sub Essai()
  Const cdL$ = "AK" 'colonne de départ en Lettres : AK
  Const nct As Byte = 6 'nombre de colonnes à traiter : 6 (de AK à AP)
  nci = 10 'n° col devant laquelle insérer 1 col ; au départ : J = 10
  ncv = Columns(cdL).Column: dlg = Cells(Rows.Count, 1).End(3).Row
  Application.ScreenUpdating = 0: ncf = 0
  Do: Job: Loop Until ncf = nct
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis. ;)

soan
 

Pièces jointes

  • Test macro.xlsm
    27.7 KB · Affichages: 6

Guileo

XLDnaute Nouveau
Bonjour Guileo, Rouge, job75,

ton fichier en retour ; fais Ctrl e ➯ travail effectué :

ça a ajouté 3 colonnes devant l'ancienne colonne J pour David, Louise, et Simon.

➯ maintenant, la colonne "Désignation" se retrouve en colonne M. 😊



code VBA de Module1 (49 lignes) :

VB:
Option Explicit

Const cf& = 5287936 'couleur de fond : vert foncé

Dim nci% 'n° col devant laquelle insérer 1 col ; au départ : J = 10
Dim ncv% 'n° colonne à vérifier ; au départ, pour la colonne AK : 37
Dim ncf As Byte 'nombre de colonnes faites ; au départ : 0 colonne
Dim dlg& 'dernière ligne utilisée ; ce sera selon la colonne A

Private Sub Job() 'pour traiter chaque colonne l'une après l'autre,
                  'à partir de la colonne cdL / ncv : AK / 37
  Dim k&, n&, i&
  For i = 7 To dlg
    If Cells(i, ncv).Interior.Color = cf Then
      n = n + 1 'nb de cellules de fond cf dans la colonne ncv
      If n = 1 Then 'pour la 1ère cellule de fond cf
        Columns(nci).Insert 2, 0: nci = nci + 1: ncv = ncv + 1
        k = nci - 1
        With Cells(4, k)
          .Borders(9).Color = 12566463: .Borders(9).LineStyle = 1
          With .Offset(-1).Resize(5)
            .Borders(10).Color = 12566463: .Borders(10).LineStyle = 1
            .Borders(7).Color = 12566463: .Borders(7).LineStyle = 1
          End With
          With .Offset(1).Resize(4).Borders(12)
            .Color = 12566463: .LineStyle = 1: .Weight = 1
          End With
          .Value = Cells(3, ncv)
        End With
      End If
      With Cells(i, k)
        .HorizontalAlignment = 4: .IndentLevel = 1
        .NumberFormat = "#,##0.0000;-#,##0.0000;"
        .Value = Cells(i, ncv)
      End With
    End If
  Next i
  ncf = ncf + 1: ncv = ncv + 1
End Sub

Sub Essai()
  Const cdL$ = "AK" 'colonne de départ en Lettres : AK
  Const nct As Byte = 6 'nombre de colonnes à traiter : 6 (de AK à AP)
  nci = 10 'n° col devant laquelle insérer 1 col ; au départ : J = 10
  ncv = Columns(cdL).Column: dlg = Cells(Rows.Count, 1).End(3).Row
  Application.ScreenUpdating = 0: ncf = 0
  Do: Job: Loop Until ncf = nct
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis. ;)

soan
Bonjour Soan,

Merci beaucoup pour ton retour à ma problématique.
Je suis désolé j'ai été absent ces derniers temps.
Elle fonctionne très bien et je vais l'utiliser merci.

C'est cool d'avoir de l'aide des membres de ce site :) !!!!
A très bientôt
Guil
 

Guileo

XLDnaute Nouveau
Votre macro modifiée
VB:
Sub Bouton1_Cliquer()
    Dim n As Long, Coul As Long, l As Long, k As Long
    Application.ScreenUpdating = False
    n = Range("CB1").Value
    Coul = Range("CB1").Interior.Color
    l = Range("CB2").Value
    k = n + l + 2
    For i = l To n + l
        If Range("AT" & i).Interior.Color = Coul Then
            Range("J" & k).Value = Range("AT3").Value
            Range("A" & k & ":AT" & k).Value = Range("A" & i & ":AT" & i).Value
            Range("AT" & k).Interior.Color = Coul
            k = k + 1
        End If
        If Range("AU" & i).Interior.Color = Coul Then
            Range("J" & k).Value = Range("AU3").Value
            Range("A" & k & ":AU" & k).Value = Range("A" & i & ":AU" & i).Value
            Range("AU" & k).Interior.Color = Coul
            k = k + 1
        End If
        If Range("AV" & i).Interior.Color = Coul Then
            Range("J" & k).Value = Range("AV3").Value
            Range("A" & k & ":AV" & k).Value = Range("A" & i & ":AV" & i).Value
            Range("AV" & k).Interior.Color = Coul
            k = k + 1
        End If
        If Range("AW" & i).Interior.Color = Coul Then
            Range("J" & k).Value = Range("AW3").Value
            Range("A" & k & ":AW" & k).Value = Range("A" & i & ":AW" & i).Value
            Range("AW" & k).Interior.Color = Coul
            k = k + 1
        End If
        If Range("AX" & i).Interior.Color = Coul Then
            Range("J" & k).Value = Range("AX3").Value
            Range("A" & k & ":AX" & k).Value = Range("A" & i & ":AX" & i).Value
            Range("AX" & k).Interior.Color = Coul
            k = k + 1
        End If
        If Range("AY" & i).Interior.Color = Coul Then
            Range("J" & k).Value = Range("AY3").Value
            Range("A" & k & ":AY" & k).Value = Range("A" & i & ":AY" & i).Value
            Range("AY" & k).Interior.Color = Coul
            k = k + 1
        End If
    Next
End Sub

Cdlt
Re bonjour Rouge,
En appliquant celle-ci je me rend compte que tu ne viens pas écrire le contenu des colonnes en AU3, AV3, ... dans les lignes J correspondantes.
As-tu un moyen d'ajouter cela ?

Bien à toi
Guil
 

Rouge

XLDnaute Impliqué
Bonjour,

Je ne comprends pas, d'une part soan, que je salue, vous a fait une proposition qui vous convenait, alors pourquoi revenir sur ma proposition qui n'était que la reprise de votre macro légèrement corrigée.

D'autre part je ne retrouve plus votre macro d'origine.

Cdlt
 

Guileo

XLDnaute Nouveau
Bonjour,

Je ne comprends pas, d'une part soan, que je salue, vous a fait une proposition qui vous convenait, alors pourquoi revenir sur ma proposition qui n'était que la reprise de votre macro légèrement corrigée.

D'autre part je ne retrouve plus votre macro d'origine.

Cdlt
Bonjour,
Merci de votre retour. C'est pour avoir les 2 options et pouvoirs proposer.
La macro initiale est ci-joint.
Il n'y a qu'une légère modification à apporter de celle que vous m'avez amélioré :)

Bien à vous,
Guil
 

Pièces jointes

  • MacroTest.xlsm
    296.9 KB · Affichages: 3

Rouge

XLDnaute Impliqué
"Merci de votre retour. C'est pour avoir les 2 options et pouvoirs proposer."

Là, votre raisonnement n'est pas bon, Soan vous à proposer un code simple et efficace alors que moi je n'ai que corriger votre code initial, entre les 2 il n'y a pas photo, d'autant plus que le nouveau fichier comporte des colonnes supplémentaires et on ne sait pas où cela va s'arrêter, donc inutile de continuer à vouloir appliquer le correctif de votre code car il n'est pas évolutif.
Si, sur le code de Soan, il y a quelques adaptation à faire, il s'est gentiment proposé de vous les faire.

Quant à ma proposition initiale, laissez tombé, ça n'a pas de sens logique.

Cdlt
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou