Microsoft 365 [RESOLU] VBA boucle, insertion plusieurs lignes, exécution formules, suppression sur si

J

JVOS

XLDnaute Junior
Bonjour
Sur la feuille "export_cb" j'ai des données sur 8 colonnes et une macro qui fait plusieurs choses.
1 - Trier les données sur la colonne A : c'est Ok
2 - Récupérer donnée en J1, coller en B2 et incrémenter jusqu'à la dernière ligne : c'est OK
Ca fonctionne beaucoup moins bien à partir de la boucle :
Pour chaque ligne renseignée à partir de la ligne2 (i=2)
3 - Copier/insérer la ligne (i), sur (i+1) supprimer les données dans les colonnes C D H, effectuer des formules en C D G
4 - si G de la nouvelle ligne (i+1) = H de la ligne (i) recommencer la boucle avec la prochaine ligne
5 - si G de la nouvelle ligne (i+1) <> H de la ligne (i) alors : Copier/insérer la ligne (i), sur (i+2) supprimer les données dans les colonnes C D H, effectuer des formules en C G
recommencer la boucle avec la prochaine ligne
La boucle est fini.
Mon problème :
la macro fais une boucle sur l'action "3" et non pas comme voulu sur les actions "3-4-5"
Merci pour votre temps
Cordialement
 

Pièces jointes

  • export-cb.xlsm
    84 KB · Affichages: 8
Solution
Gégé-45550
JVOS à dit:
Bonjour
Sur la feuille "export_cb" j'ai des données sur 8 colonnes et une macro qui fait plusieurs choses.
1 - Trier les données sur la colonne A : c'est Ok
2 - Récupérer donnée en J1, coller en B2 et incrémenter jusqu'à la dernière ligne : c'est OK
Ca fonctionne beaucoup moins bien à partir de la boucle :
Pour chaque ligne renseignée à partir de la ligne2 (i=2)
3 - Copier/insérer la ligne (i), sur (i+1) supprimer les données dans les colonnes C D H, effectuer des formules en C D G
4 - si G de la nouvelle ligne (i+1) = H de la ligne (i) recommencer la boucle avec la prochaine ligne
5 - si G de la nouvelle ligne (i+1) <> H de la ligne (i) alors : Copier/insérer la ligne (i), sur (i+2) supprimer les données dans les colonnes C D H...
Cliquez pour agrandir...
Trier par date Trier par votes
Gégé-45550

Gégé-45550

XLDnaute Accro
JVOS à dit:
Bonjour
Sur la feuille "export_cb" j'ai des données sur 8 colonnes et une macro qui fait plusieurs choses.
1 - Trier les données sur la colonne A : c'est Ok
2 - Récupérer donnée en J1, coller en B2 et incrémenter jusqu'à la dernière ligne : c'est OK
Ca fonctionne beaucoup moins bien à partir de la boucle :
Pour chaque ligne renseignée à partir de la ligne2 (i=2)
3 - Copier/insérer la ligne (i), sur (i+1) supprimer les données dans les colonnes C D H, effectuer des formules en C D G
4 - si G de la nouvelle ligne (i+1) = H de la ligne (i) recommencer la boucle avec la prochaine ligne
5 - si G de la nouvelle ligne (i+1) <> H de la ligne (i) alors : Copier/insérer la ligne (i), sur (i+2) supprimer les données dans les colonnes C D H, effectuer des formules en C G
recommencer la boucle avec la prochaine ligne
La boucle est fini.
Mon problème :
la macro fais une boucle sur l'action "3" et non pas comme voulu sur les actions "3-4-5"
Merci pour votre temps
Cordialement
Cliquez pour agrandir...
Bonsoir,
à tester :
VB: 
Sub export_cb2()
'
' export_cb2 Macro
'

    Dim DL, i As Long
    Dim ValeurDepart As Long
    Dim FeuilleSource As Worksheet
    Dim FeuilleCible As Worksheet
    'Dim DerniereLigne As Long
   

    ' Désactiver la mise à jour de l'écran
    Application.ScreenUpdating = True

    ' Définir les feuilles
    Set FeuilleSource = Worksheets("export_cb")  ' Feuille à trier
    Set FeuilleCible = FeuilleSource ' Feuille de destination (peut être modifiée)

    ' ---- Tri chronologique colonne A ----
    ' Déterminer la dernière ligne avec des données dans la colonne A
    DL = FeuilleSource.Cells(Rows.Count, "A").End(xlUp).Row

    ' Trier les données de la colonne A par ordre croissant
    With FeuilleSource.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A" & DL), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:H" & DL)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
   ' Déterminer la dernière ligne avec des données dans la colonne A
    With FeuilleSource
'        DerniereLigne = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Copier la valeur de J1 dans B2
        .Range("B2:B" & DL).Value = .Range("J1").Value

        ' Incrémenter les valeurs dans la colonne B jusqu'à la dernière ligne
'        ValeurDepart = .Range("B2").Value
'        For i = 3 To DerniereLigne
'            .Cells(i, "B").Value = ValeurDepart
'            ValeurDepart = ValeurDepart + 1
'        Next i
    End With


    ' ---- Incrémenter et insérer des lignes ----
 
    ' Boucle pour parcourir les lignes de la feuille triée
    For i = DL To 2 Step -1
   
        ' Copier les valeurs de la ligne courante
        FeuilleSource.Rows(i).Copy
        ' Coller les valeurs dans les lignes insérées
        FeuilleSource.Rows(i + 1).Insert
        ' Effacer le contenu des cellules C1 et D1 de la ligne insérée
        FeuilleSource.Range("C" & i + 1 & ":D" & i + 1).ClearContents

        ' Effacer le contenu des cellules H1 de la ligne insérée
        FeuilleSource.Range("H" & i + 1).ClearContents
       
        ' ---- Formules et calculs ----

            ' Formule VLOOKUP dans C (ligne i+1)
            FeuilleSource.Cells(i + 1, 3).FormulaR1C1 = "=VLOOKUP(RC[2],'LIB CB'!C1:C5,2,FALSE)"

            ' Formule VLOOKUP dans D (ligne i+1)
            FeuilleSource.Cells(i + 1, 4).FormulaR1C1 = "=VLOOKUP(RC[1],'LIB CB'!C1:C5,3,FALSE)"

            ' Formule de calcul dans G (ligne i+1)
            FeuilleSource.Cells(i + 1, 7).FormulaR1C1 = "=IF(VLOOKUP(RC[-2],'LIB CB'!C1:C5,5,FALSE)=0,round(R[-1]C[1],2),ROUND(R[-1]C[1]/1.2,2))"

       
        ' Vérifier si (G i+1)<>(H i)
       If FeuilleSource.Range("G" & i + 1) <> FeuilleSource.Range("H" & i) Then
        ' Copier les valeurs de la ligne courante
            FeuilleSource.Rows(i).Copy
        ' Coller les valeurs dans les lignes insérées
            FeuilleSource.Rows(i + 2).Insert
        ' Effacer le contenu des cellules C1 et D2 des lignes insérées
            FeuilleSource.Range("C" & i + 2 & ":D" & i + 2).ClearContents
        ' Effacer le contenu des cellules H1  des lignes insérées
            FeuilleSource.Range("H" & i + 2 & ":H" & i + 2).ClearContents
           
        ' Formule VLOOKUP dans C (ligne i+2)
            FeuilleSource.Cells(i + 2, 3).FormulaR1C1 = "=VLOOKUP(RC[2],'LIB CB'!C1:C5,5,FALSE)"
        ' Formule de calcul dans H (ligne i+2)
            FeuilleSource.Cells(i + 2, 7).FormulaR1C1 = "=IF(VLOOKUP(RC[-2],'LIB CB'!C1:C5,5,FALSE)=0,0,ROUND(R[-2]C[1]/1.2*0.2,2))"
             
        End If
         
     
    Next i
   
    Application.ScreenUpdating = True

End Sub

Cordialement,
 
Vote positif 0 Vote négatif
Solution
J

JVOS

XLDnaute Junior
Gégé-45550 à dit:
Bonsoir,
à tester :
VB: 
Sub export_cb2()
'
' export_cb2 Macro
'

    Dim DL, i As Long
    Dim ValeurDepart As Long
    Dim FeuilleSource As Worksheet
    Dim FeuilleCible As Worksheet
    'Dim DerniereLigne As Long
  

    ' Désactiver la mise à jour de l'écran
    Application.ScreenUpdating = True

    ' Définir les feuilles
    Set FeuilleSource = Worksheets("export_cb")  ' Feuille à trier
    Set FeuilleCible = FeuilleSource ' Feuille de destination (peut être modifiée)

    ' ---- Tri chronologique colonne A ----
    ' Déterminer la dernière ligne avec des données dans la colonne A
    DL = FeuilleSource.Cells(Rows.Count, "A").End(xlUp).Row

    ' Trier les données de la colonne A par ordre croissant
    With FeuilleSource.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A" & DL), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:H" & DL)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  
   ' Déterminer la dernière ligne avec des données dans la colonne A
    With FeuilleSource
'        DerniereLigne = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Copier la valeur de J1 dans B2
        .Range("B2:B" & DL).Value = .Range("J1").Value

        ' Incrémenter les valeurs dans la colonne B jusqu'à la dernière ligne
'        ValeurDepart = .Range("B2").Value
'        For i = 3 To DerniereLigne
'            .Cells(i, "B").Value = ValeurDepart
'            ValeurDepart = ValeurDepart + 1
'        Next i
    End With


    ' ---- Incrémenter et insérer des lignes ----
 
    ' Boucle pour parcourir les lignes de la feuille triée
    For i = DL To 2 Step -1
  
        ' Copier les valeurs de la ligne courante
        FeuilleSource.Rows(i).Copy
        ' Coller les valeurs dans les lignes insérées
        FeuilleSource.Rows(i + 1).Insert
        ' Effacer le contenu des cellules C1 et D1 de la ligne insérée
        FeuilleSource.Range("C" & i + 1 & ":D" & i + 1).ClearContents

        ' Effacer le contenu des cellules H1 de la ligne insérée
        FeuilleSource.Range("H" & i + 1).ClearContents
      
        ' ---- Formules et calculs ----

            ' Formule VLOOKUP dans C (ligne i+1)
            FeuilleSource.Cells(i + 1, 3).FormulaR1C1 = "=VLOOKUP(RC[2],'LIB CB'!C1:C5,2,FALSE)"

            ' Formule VLOOKUP dans D (ligne i+1)
            FeuilleSource.Cells(i + 1, 4).FormulaR1C1 = "=VLOOKUP(RC[1],'LIB CB'!C1:C5,3,FALSE)"

            ' Formule de calcul dans G (ligne i+1)
            FeuilleSource.Cells(i + 1, 7).FormulaR1C1 = "=IF(VLOOKUP(RC[-2],'LIB CB'!C1:C5,5,FALSE)=0,round(R[-1]C[1],2),ROUND(R[-1]C[1]/1.2,2))"

      
        ' Vérifier si (G i+1)<>(H i)
       If FeuilleSource.Range("G" & i + 1) <> FeuilleSource.Range("H" & i) Then
        ' Copier les valeurs de la ligne courante
            FeuilleSource.Rows(i).Copy
        ' Coller les valeurs dans les lignes insérées
            FeuilleSource.Rows(i + 2).Insert
        ' Effacer le contenu des cellules C1 et D2 des lignes insérées
            FeuilleSource.Range("C" & i + 2 & ":D" & i + 2).ClearContents
        ' Effacer le contenu des cellules H1  des lignes insérées
            FeuilleSource.Range("H" & i + 2 & ":H" & i + 2).ClearContents
          
        ' Formule VLOOKUP dans C (ligne i+2)
            FeuilleSource.Cells(i + 2, 3).FormulaR1C1 = "=VLOOKUP(RC[2],'LIB CB'!C1:C5,5,FALSE)"
        ' Formule de calcul dans H (ligne i+2)
            FeuilleSource.Cells(i + 2, 7).FormulaR1C1 = "=IF(VLOOKUP(RC[-2],'LIB CB'!C1:C5,5,FALSE)=0,0,ROUND(R[-2]C[1]/1.2*0.2,2))"
            
        End If
        
    
    Next i
  
    Application.ScreenUpdating = True

End Sub

Cordialement,
Cliquez pour agrandir...
Bonjour
Merci d'avoir passer du temps, avec quelques modifications et tes corrections, ma macro fonctionne comme je le souhaite.
Merci beaucoup
 
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
@JVOS

JVOS à dit:
Quand j'ai lancé la macro, ça bug au
Ws1.Range("G" & i + 1).FormulaLocal = LaFormule
Cliquez pour agrandir...

Pourtant chez moi mon fichier du post # 3 fonctionne sans erreur

20241011_105353.gif
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
XL 2016 Boucle For ne s'exécute pas comme une boucle et boucle infinie
Réponses
2
Affichages
251
Stéphane_1
S
p'tit vieux
  • Question
XL 2021 VBA: Extraction des paramètres d'une formule (texte)
2
Réponses
28
Affichages
535
p'tit vieux
p'tit vieux
Nadou69
  • Résolu(e)
XL 2019 Erreur dans ma macro
Réponses
9
Affichages
257
Nadou69
Nadou69
M
  • Résolu(e)
XL 2021 PUBLIPOSTAGE : Mise en forme du corps de message issu d'une cellule excel (VBA)
Réponses
4
Affichages
183
Minus&Cortex
M
F
  • Résolu(e)
Microsoft 365 Comment enregistrer chaque ligne en tant que fichier texte dans Excel?
2
Réponses
24
Affichages
556
TooFatBoy
TooFatBoy
chris6999
  • Question
Microsoft 365 Boucle VB pour supprimer les caractères spéciaux et numériques d'une chaîne
Réponses
5
Affichages
307
patricktoulon
patricktoulon
S
  • Question
XL 2016 Transposer colonnes sur lignes
Réponses
7
Affichages
139
gbinforme
G
S
  • Résolu(e)
Microsoft 365 [RESOLU] Excel : Calcul de prix en fonction d'un type
Réponses
4
Affichages
83
JHA
J
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
880
job75
job75
A
  • Résolu(e)
Microsoft 365 Suppression d'une ligne d'un tableau avec une macro
Réponses
13
Affichages
615
Alain 79
A

Membres actuellement en ligne

15 membres et 97 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 188
Messages
2 106 976
Membres
109 731
dernier inscrit
Benjamin91450