VBA insertion ligne après un groupe trié

Le 18/05/2022 à 23:00

Bonsoir,
Je tourne en rond sans pouvoir trouver la solution: j'ai un tableau sur lequel je fait préalablement des tris (ici colonne B). Je n'arrive pas à écrire le bon code pour effectuer une insertion de ligne après chacun des blocs de cellules similaire en colonne B. Evidement le tableau à une valeur qui peut varier suivant la mise à jours des datas. Pourriez vous m'aider à résoudre mon problème?

9insertion-ligne.xlsm (11.79 Ko)
Le 19/05/2022 à 01:11

Bonjour mimijunior

Public wsDepart                 As Worksheet
Public wsResult                 As Worksheet
Public tabData()
Public tabVisu()

Sub TestVisu()
Dim cptData
Dim cptVisu
Dim cptCol

    Set wsDepart = Worksheets("Départ")
    Set wsResult = Worksheets("Resultat")

    With wsDepart
        tabData = Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 4))
    End With

    cptVisu = 0
    For cptData = 1 To UBound(tabData, 1)
        If Not (cptData = 1) Then
            cptVisu = cptVisu + IIf(tabData(cptData - 1, 2) = tabData(cptData, 2), 0, 1)
        End If
        cptVisu = cptVisu + 1
        ReDim Preserve tabVisu(1 To UBound(tabData, 2), 1 To cptVisu)
        For cptCol = 1 To UBound(tabData, 2)
            tabVisu(cptCol, cptVisu) = tabData(cptData, cptCol)
        Next
    Next

    With wsResult
        .Cells(2, 6).Resize(UBound(tabVisu, 2), UBound(tabVisu, 1)) = Application.Transpose(tabVisu)
    End With

    Set wsDepart = Nothing
    Set wsResult = Nothing

End Sub

à tester... au besoin je peux commenter le code !

Le 19/05/2022 à 10:05

C'est topissime..merci ! Est il possible de faire dérouler la macro sur la feuille "Départ"?

En effet je veux bien des explications

Le 19/05/2022 à 11:21

Bonjour mimijunior

Pour ce qui est des explications...

'   Declaration des Onglets
Public wsDepart                 As Worksheet
Public wsResult                 As Worksheet

'   Declaration des Tableaux
Public tabData()    '   La base à transformer
Public tabVisu()    '   Le résultat

Sub TestVisu()
Dim cptData         '   Compteur pour les données à traiter
Dim cptVisu         '   Compteur pour les données résultantes
Dim cptCol          '   Compteur pour les colonnes

    '   Initialiser les onglets
    Set wsDepart = Worksheets("Départ")
    Set wsResult = Worksheets("Resultat")

    '   Depuis l'onglet [Départ]
    '   Placer les données dans le tableau "base à transformer"
    With wsDepart
        tabData = Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 4))   '   *1
    End With

    '   Au départ on considère qu'aucune donnée n'existe (cptVisu = 0)
    cptVisu = 0
    '   Parcourir toutes les données de la "base à transformer"
    For cptData = 1 To UBound(tabData, 1)   '   *2
        '   Traiter le cas particulier de la 1ère donnée    *3
        If Not (cptData = 1) Then
            cptVisu = cptVisu + IIf(tabData(cptData - 1, 2) = tabData(cptData, 2), 0, 1)
        End If

        '   Augmenter le compteur des données résultantes
        cptVisu = cptVisu + 1
        '   Redimensionner le tableau *4/*5
        ReDim Preserve tabVisu(1 To UBound(tabData, 2), 1 To cptVisu)
        '   Pour chacune des colonnes , transfert des données à transformer vers les données résultantes
        For cptCol = 1 To UBound(tabData, 2)
            tabVisu(cptCol, cptVisu) = tabData(cptData, cptCol)
        Next
    Next

    '   Copie du tableau résultant dans l'onglet [Resultat] *6
    With wsResult
        .Cells(2, 6).Resize(UBound(tabVisu, 2), UBound(tabVisu, 1)) = Application.Transpose(tabVisu)
    End With

    '   Libérer les variables objet "Worksheet" (pour ne pas engorger la mémoire) !
    Set wsDepart = Nothing
    Set wsResult = Nothing

End Sub

'   Explications complémentaires
'   *1
'   .Cells(Rows.Count, 1).End(xlUp).Row...
'   Permet de connaitre la dernière ligne de données, dans laquelle
'   Rows.Count  donne la dernière ligne de Excel (différente selon les versions)
'   End(xlup)   permet de simuler depuis cette dernière ligne la remontée vers le haut
'               comme l'appui sur [CTRL+Flèche Haut]
'   Row         pour obtenir le n° de laligne aisni atteinte
'
'   *2
'   Ubound(tablo,1)
'   Permet de connaitre la dimension d'un tableau
'   Dans ce cas donc, le nombre de lignes de donnée à transfomer
'
'   *3
'   Comme la comparaison s'efectue sur la donnée précedente "tabData(cptData - 1, 2)"
'   lorsque nous sommes sur la 1ère ligne cela provoquerait une erreur
'   Donc la ligne "If Not (cptData = 1) Then" permet d'éviter de traiter la 1ère donnée
'   Dans les autres cas "cptVisu = cptVisu + IIf(tabData(cptData - 1, 2) = tabData(cptData, 2), 0, 1)"
'   permet d'augmenter le compteur des données résultantes de 1 à chaque fois que :
'   la donnée précédente n'est pas identique à la donnée actuelle
'   Donc de sauter une ligne !
'
'   *4
'   La mention "Preserve" permet de préserver les données existantes
'
'   *5
'   Le tableau est formaté à l'envers ! Colonnes en 1ère position et Lignes en 2ème position
'   Cela est obligatoire, parce que le tableau est dynamique (il augmente en taille)
'   Et Excel ne permet que de faire varier la dernière dimension d'un tableau
'
'   *6
'   En prenant la précaution de (ré)inverser le tableau (Application.Transpose(tabVisu))
'   Le ".Cells(2, 6).Resize(UBound(tabVisu, 2), UBound(tabVisu, 1))" permet de
'   définir le nombre de colonnes "UBound(tabVisu, 2)" et de lignes "UBound(tabVisu, 1))" à copier
'   à partir de la cellule de coordonnées (ligne=2,colonne=6)

Pour ce qui est de "sur la feuille [Départ]" ?

C'est en effet possible, cependant cela détruira les données de départ !

PS/ Merci pour le "topissime"

Le 19/05/2022 à 13:17

Merci Green SoftS,

Merci pour ces explications limpides.. je débute en vba et plus j'en apprends plus j'ai envie de persévérer dans l' apprentissage & développement en VBA.

J'aimerai bien voir le code si on écrasait les données de l'onglet "Départ", j'imagine que soit le tableau avec les sauts de lignes est réalisé quelques colonnes plus loin dans l'onglet "Départ" ou tout simplement, c'est un copié collé de l'onglet "Résultat" vers l'onglet "Départ" + effacement de l'onglet "Résultat"?

Le 19/05/2022 à 15:25

Bonjour mimijunior

Dans le code "actuel" je n'écrase pas le tableau de l'onglet [Départ], je ne le colle pas non plus au sens de "copier/coller"

La programmation sert à "inventer" un nouveau tableau (au sens VBA - nommé tabVisu), une fois ce tableau créé je le positionne sur l'onglet [Resultat] par le biais de la ligne .Cells(2, 6).Resize(UBound(tabVisu, 2), UBound(tabVisu, 1)) = Application.Transpose(tabVisu)

Dans mon idée de départ, à la lecture de ta PJ, j'ai supposé le tableau de l'onglet [Départ] comme pouvant être une sorte de base de données beaucoup plus conséquente et surtout comme étant "utile", c'est-à-dire non effaçable !

Cependant, il est envisageable effectivement, de remplacer ce tableau si son importance est relative...

Cela sous-entend

  • que tu es en mesure de "retrouver les données de base", OU
  • que d'autres données peuvent venir à nouveau écraser ce tableau "inventé", au quel cas il faut (ré)inventer à nouveau

Autre possibilité, si le tableau de départ n'est pas trop volumineux en terme de colonne, le tableau résultat peut effectivement être placé à droite du 1er

J'espère que mes explications sont claires...?

Reste à savoir maintenant ce que tu veux faire de ces 2 tableaux ! Comment tu veux les organiser et plus encore les exploiter !

Le 21/05/2022 à 09:27

Bonjour Green SoftS,

Peux adapter le code pour que l'insertion de ligne se fasse dans l'onglet "Départ" et non dans celui de "Résultats" s'il te plait?

Bon WeekEnd

Le 22/05/2022 à 08:37

Bonjour mimijunior

Aucun problème pour cela, cependant je te le redemande n'as-tu pas besoin de conserver la version "brute" ?

Bref la modification est toute simple :

'   Declaration des Onglets
Public wsDepart                 As Worksheet
Public wsResult                 As Worksheet

'   Declaration des Tableaux
Public tabData()    '   La base à transformer
Public tabVisu()    '   Le résultat

Sub TestVisu()
Dim cptData         '   Compteur pour les données à traiter
Dim cptVisu         '   Compteur pour les données résultantes
Dim cptCol          '   Compteur pour les colonnes

    '   Initialiser les onglets
    Set wsDepart = Worksheets("Départ")
    Set wsResult = Worksheets("Resultat")

    '   Depuis l'onglet [Départ]
    '   Placer les données dans le tableau "base à transformer"
    With wsDepart
        tabData = Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 4))   '   *1
    End With

    '   Au départ on considère qu'aucune donnée n'existe (cptVisu = 0)
    cptVisu = 0
    '   Parcourir toutes les données de la "base à transformer"
    For cptData = 1 To UBound(tabData, 1)   '   *2
        '   Traiter le cas particulier de la 1ère donnée    *3
        If Not (cptData = 1) Then
            cptVisu = cptVisu + IIf(tabData(cptData - 1, 2) = tabData(cptData, 2), 0, 1)
        End If

        '   Augmenter le compteur des données résultantes
        cptVisu = cptVisu + 1
        '   Redimensionner le tableau *4/*5
        ReDim Preserve tabVisu(1 To UBound(tabData, 2), 1 To cptVisu)
        '   Pour chacune des colonnes , transfert des données à transformer vers les données résultantes
        For cptCol = 1 To UBound(tabData, 2)
            tabVisu(cptCol, cptVisu) = tabData(cptData, cptCol)
        Next
    Next

    '   Copie du tableau résultant dans l'onglet [Resultat] *6
    '    LA MODIFICATION DOIT SE FAIRE ICI
    '    -----------------------------------------------------------
    '    L'ancien code...
    '    => With wsResult
    '    Est à remplacer par *7
    With wsDepart
        Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 4)) .ClearContents
    '    ---------------------------------------------------------[ Fin de la modification ]
        .Cells(2, 6).Resize(UBound(tabVisu, 2), UBound(tabVisu, 1)) = Application.Transpose(tabVisu)
    End With
    '    -----------------------------------------------------------

    '   Libérer les variables objet "Worksheet" (pour ne pas engorger la mémoire) !
    Set wsDepart = Nothing
    Set wsResult = Nothing

End Sub

'   Explications complémentaires
'   *1
'   .Cells(Rows.Count, 1).End(xlUp).Row...
'   Permet de connaitre la dernière ligne de données, dans laquelle
'   Rows.Count  donne la dernière ligne de Excel (différente selon les versions)
'   End(xlup)   permet de simuler depuis cette dernière ligne la remontée vers le haut
'               comme l'appui sur [CTRL+Flèche Haut]
'   Row         pour obtenir le n° de laligne aisni atteinte
'
'   *2
'   Ubound(tablo,1)
'   Permet de connaitre la dimension d'un tableau
'   Dans ce cas donc, le nombre de lignes de donnée à transfomer
'
'   *3
'   Comme la comparaison s'efectue sur la donnée précedente "tabData(cptData - 1, 2)"
'   lorsque nous sommes sur la 1ère ligne cela provoquerait une erreur
'   Donc la ligne "If Not (cptData = 1) Then" permet d'éviter de traiter la 1ère donnée
'   Dans les autres cas "cptVisu = cptVisu + IIf(tabData(cptData - 1, 2) = tabData(cptData, 2), 0, 1)"
'   permet d'augmenter le compteur des données résultantes de 1 à chaque fois que :
'   la donnée précédente n'est pas identique à la donnée actuelle
'   Donc de sauter une ligne !
'
'   *4
'   La mention "Preserve" permet de préserver les données existantes
'
'   *5
'   Le tableau est formaté à l'envers ! Colonnes en 1ère position et Lignes en 2ème position
'   Cela est obligatoire, parce que le tableau est dynamique (il augmente en taille)
'   Et Excel ne permet que de faire varier la dernière dimension d'un tableau
'
'   *6
'   En prenant la précaution de (ré)inverser le tableau (Application.Transpose(tabVisu))
'   Le ".Cells(2, 6).Resize(UBound(tabVisu, 2), UBound(tabVisu, 1))" permet de
'   définir le nombre de colonnes "UBound(tabVisu, 2)" et de lignes "UBound(tabVisu, 1))" à copier
'   à partir de la cellule de coordonnées (ligne=2,colonne=6)
'   -----------------------------------------------
'    *7
'    La ligne Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 4)).ClearContents
'    Permet d'effacer les anciennes données avant de réaliser la copie
'    Dans le même principe que *1

Merci pour

Merci Green SoftS,

Merci pour ces explications limpides

J'aime cette philosophie et n'hésite donc pas à demander conseil...

je débute en vba et plus j'en apprends plus j'ai envie de persévérer dans l' apprentissage & développement en VBA.

et n'hésite donc pas à demander d'autres conseils...

Le 22/05/2022 à 08:55

bonjour,

Si c'est un vrai tableau (=listobject), le code change un petit peu

Sub Insertion()
     With Sheets("départ")     'cette feuille
          r = .Range("A" & Rows.Count).End(xlUp).Row     'derniere ligne colonne A
          For i = r To 3 Step -1     'boucle de la dernière ligne vers la 3ieme ligne en recule !!!
               If .Range("B" & i).Value <> .Range("B" & i - 1).Value Then     'valeur dans colonne B est different que la cellule en haut
                    .Range("A" & i).Resize(, 4).Insert     'insertion de 4 cellules
               End If
          Next
     End With
End Sub
Le 22/05/2022 à 09:28

Bonjour BsAlv

D'après la PJ en exemple

Si c'est ce n'est pas un vrai tableau (=listobject), le code change un petit peu

Le 22/05/2022 à 09:52

Bonjour à tous,
Une proposition Power Query.
Les données sont sous forme de tableaux structurés.
Cdlt.

capture d ecran 2022 05 22 095154
3pq-insertion-lignes-vides.xlsx (21.46 Ko)
Rechercher des sujets similaires à "vba insertion ligne groupe trie"