Organiser des données avec une macro VBA

Question

Je suis débutant en VBA. Je cherche à écrire une macro VBA afin d'organiser mes données. J'ai des valeurs numériques dans la colonne A (ligne 1 à 200 par exemple). Je souhaite décaler la valeur A2 en B1, la valeur A4 en B3, la valeur A6 en B5, et ainsi de suite jusqu'à la ligne 300. (voir images ci-jointes) Puis, supprimer les lignes A2, A4, A6, ..., qui sont maintenant vides. J'ai bien essayé différents codes, sans prétention, et sans succès. J'ai notamment testé le code ci-dessous mais dans tous les cas ça ne marchera pas en fait car Excel ne peut pas couper plusieurs plages non contiguës d'un coup. De plus, il manque le fait de supprimer les lignes vides avec une instruction du type Delete Shift:=xlUp . Sub test() Set plage = Cells(2, 1) For i = 1 To 300 Step 2 Set plage = Union(plage, Cells(i, 1)) Next i plage.Select Selection.Cut Range("B1").Select ActiveSheet.Paste End Sub En fait, il me faudrait une boucle à partir de A2 (i=2): couper la cellule A(i) avec i commençant à 2 coller sur la cellule B(i-1) couper la cellule A(i+2) coller sur la cellule B((i+2)-1) 'Ceci jusqu'à la ligne 300 par exemple. -Supprimer les lignes des cellules coupées A(i), A(i+2), ... Si quelqu'un peut m'apporter une solution ou m'aider, j'en serais ravi ! Je voudrais même ajouter une instruction ensuite qui consisterait à décaler par paquets de 5 lignes des colonnes A+B dans les colonnes adjacentes. Autrement dit, couper les cellules (A6:A10;B6:B10) pour les coller en (C1:C5;D1:D5), puis couper les cellules (A11:A15;B11:B15) pour les coller en (E1:E5;F1:F5), etc. (voir image ci-jointe) Merci de m'avoir lu et pour votre aide éventuelle. Bonne soirée, D-BuG...

MFerrand · Accepted Answer

En fait le test qui était fait lors de la saisie dans l' InputBox prévoyait presque tous les cas : si lgr = "", c'est que l'utilisateur avait cliqué sur Annuler, donc on sortait, si lgr n'était pas un nombre, on lui signalait et on sortait, plutôt que de sortir, l'ensemble dans une boucle Do... Loop lui renvoie l'InputBox pour recommencer la saisie... - si lgr était un nombre on poursuivait, la conversion éliminait la possibilité d'un nombre décimal, il reste là à tester que la valeur est supérieure à 0, sinon lui signaler et boucler comme pour le cas précédent. On ne sortirait ainsi qu'avec un nombre entier positif ou en annulant. Do lgr = InputBox("Indiquer le nombre de lignes de groupement des données dans le " _ & "tableau final.", "Groupement des données") If lgr = "" Then Exit Sub ElseIf IsNumeric(lgr) Then lgr = CInt(lgr) If lgr &gt; 0 Then Exit Do Else MsgBox "Taper un nombre entier positif !", vbExclamation, "Groupement des données" End If Else MsgBox "Taper un nombre !", vbExclamation, "Groupement des données" End If Loop NB : la conversion avec CInt arrondit à l'entier le plus proche, mais pour les décimales égales à 0,5 c'est à l'entier pair le plus proche : 0,5 sera arrondi à 0, 1,5 sera arrondi à 2, mais 0,75 ou 1,25 seront arrondis à 1... Cordialement...

MFerrand · Answer

Essaie ainsi : Sub Test() Dim PlV(), PlH(), i%, n%, dvi With ActiveSheet n = .Cells(.Rows.Count, 1).End(xlUp).Row ReDim PlV(1 To n \ 2, 0) ReDim PlH(1 To n \ 2) For i = 2 To n Step 2 PlH(i / 2) = .Cells(i, 1) PlV(i / 2, 0) = .Cells(i - 1, 1) Next i If n Mod 2 = 1 Then dvi = .Cells(i - 1, 1) Application.ScreenUpdating = False With .Range("A1") .CurrentRegion.ClearContents .Resize(n \ 2).Value = PlV If n Mod 2 = 1 Then .Offset(n \ 2) = dvi End With .Range("B1").Resize(, n \ 2).Value = PlH End With End Sub Cordialement...

MFerrand · Answer

Je devais déjà fatiguer un peu ! J'étais persuadé qu'il y avait une colonne et une ligne à la fin ! Je t'arrange ça.....

MFerrand · Answer

Voilà ! ça simplifie... Sub Test() Dim PlgR(), i%, n% With ActiveSheet n = .Cells(.Rows.Count, 1).End(xlUp).Row ReDim PlgR(1 To n \ 2 + (n Mod 2), 1) For i = 2 To n Step 2 PlgR(i / 2, 0) = .Cells(i - 1, 1) PlgR(i / 2, 1) = .Cells(i, 1) Next i If n Mod 2 = 1 Then PlgR(i / 2, 0) = .Cells(i - 1, 1) Application.ScreenUpdating = False With .Range("A1") .CurrentRegion.ClearContents .Resize(UBound(PlgR), 2).Value = PlgR End With End With End Sub C'est genre "bête et méchant" ! On fait un tableau, on efface tout et on met le nouveau tableau ! Cordialement...

MFerrand · Answer

Il ne s'agissait donc que d'un résultat intermédiaire... ! Il faut voir si l'on peut facilement obtenir le résultat finale sans matérialiser ce résultat intermédiaire... Je regarderai dès que possible... Cordialement...

MFerrand · Answer

Hier, pas dispo pour travailler... On passe par le premier tableau intermédiaire, mais sans le matérialiser... Sub Test() Dim PlgR(), PlgF(), i%, n% With ActiveSheet n = .Cells(.Rows.Count, 1).End(xlUp).Row ReDim PlgR(1 To n \ 2 + (n Mod 2), 1) For i = 2 To n Step 2 PlgR(i / 2, 0) = .Cells(i - 1, 1) PlgR(i / 2, 1) = .Cells(i, 1) Next i If n Mod 2 = 1 Then PlgR(i / 2, 0) = .Cells(i - 1, 1) n = UBound(PlgR, 1) \ 5 + (UBound(PlgR, 1) Mod 5 = 0) ReDim PlgF(1 To 5, n * 2 + 1) For n = 0 To UBound(PlgF, 2) Step 2 If UBound(PlgR, 1) &lt; 1 + n / 2 * 5 Then Exit For For i = 1 To 5 PlgF(i, n) = PlgR(i + n / 2 * 5, 0) If PlgR(i + n / 2 * 5, 1) = "" Then Exit For PlgF(i, n + 1) = PlgR(i + n / 2 * 5, 1) Next i Next n Application.ScreenUpdating = False With .Range("A1") .CurrentRegion.ClearContents .Resize(5, UBound(PlgF, 2) + 1).Value = PlgF End With End With End Sub Cordialement...

MFerrand · Answer

Normalement oui ! Je vérifierai... (j'ai un peu de mal à répondre à tous en ce moment... ) On peut rendre variable ce groupement par 5, 8 ou autre, en le faisant définir au départ par l'utilisateur (questionnement par InputBox). Je vois ça dès que je peux. Cordialement...

MFerrand · Answer

Nouvelle version :

Sub Test()
    Dim PlgR(), PlgF(), i%, n%, lgr
    lgr = InputBox("Indiquer le nombre de lignes de groupement des données dans le " _
     & "tableau final.", "Groupement des données")
    If lgr = "" Then
        Exit Sub
    ElseIf IsNumeric(lgr) Then
        lgr = CInt(lgr)
    Else
        MsgBox "Taper un nombre !", vbExclamation, "Groupement des données"
        Exit Sub
    End If
    With ActiveSheet
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        ReDim PlgR(1 To n \ 2 + (n Mod 2), 1)
        For i = 2 To n Step 2
            PlgR(i / 2, 0) = .Cells(i - 1, 1)
            PlgR(i / 2, 1) = .Cells(i, 1)
        Next i
        If n Mod 2 = 1 Then PlgR(i / 2, 0) = .Cells(i - 1, 1)
        n = UBound(PlgR, 1) \ lgr + (UBound(PlgR, 1) Mod lgr = 0)
        ReDim PlgF(1 To lgr, n * 2 + 1)
        For n = 0 To UBound(PlgF, 2) Step 2
            If UBound(PlgR, 1) < 1 + n / 2 * lgr Then Exit For
            For i = 1 To lgr
                PlgF(i, n) = PlgR(i + n / 2 * lgr, 0)
                If PlgR(i + n / 2 * lgr, 1) = "" Then Exit For
                PlgF(i, n + 1) = PlgR(i + n / 2 * lgr, 1)
            Next i
        Next n
        Application.ScreenUpdating = False
        With .Range("A1")
            .CurrentRegion.ClearContents
            .Resize(lgr, UBound(PlgF, 2) + 1).Value = PlgF
        End With
    End With
End Sub

Cordialement.

MFerrand · Answer

A priori, c'est que tu as tapé un nombre supérieur à la moitié de ton nombre de lignes initial !

Merci de le vérifier.

Je n'ai pas verrrouillé pour ce type d'erreur, mais on pourra facilement le faire...

Cordialement.

MFerrand · Answer

C'est de ma faute ! Je me suis focalisé sur un nombre de lignes impaires et ai omis de tester sur un nombre pair ne correspondant pas à un multiple de bloc...

Bon, version rectifiée (les parties modifiées sont surlignées):

Sub Test()
    Dim PlgR(), PlgF(), i%, n%, lgr
    lgr = InputBox("Indiquer le nombre de lignes de groupement des données dans le " _
     & "tableau final.", "Groupement des données")
    If lgr = "" Then
        Exit Sub
    ElseIf IsNumeric(lgr) Then
        lgr = CInt(lgr)
    Else
        MsgBox "Taper un nombre !", vbExclamation, "Groupement des données"
        Exit Sub
    End If
    With ActiveSheet
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        ReDim PlgR(1 To n \ 2 + (n Mod 2), 1)
        For i = 2 To n Step 2
            PlgR(i / 2, 0) = .Cells(i - 1, 1)
            PlgR(i / 2, 1) = .Cells(i, 1)
        Next i
        If n Mod 2 = 1 Then PlgR(i / 2, 0) = .Cells(i - 1, 1)
        n = UBound(PlgR, 1) \ lgr + (UBound(PlgR, 1) Mod lgr = 0)
        ReDim PlgF(1 To lgr, n * 2 + 1)
        For n = 0 To UBound(PlgF, 2) Step 2
            For i = 1 To lgr
                If n < UBound(PlgF, 2) - 1 Then
                    PlgF(i, n) = PlgR(i + n / 2 * lgr, 0)
                    PlgF(i, n + 1) = PlgR(i + n / 2 * lgr, 1)
                Else
                    If UBound(PlgR, 1) < i + n / 2 * lgr Then Exit For
                    PlgF(i, n) = PlgR(i + n / 2 * lgr, 0)
                    If PlgR(i + n / 2 * lgr, 1) = "" Then Exit For
                    PlgF(i, n + 1) = PlgR(i + n / 2 * lgr, 1)
                End If
            Next i
        Next n
        Application.ScreenUpdating = False
        With .Range("A1")
            .CurrentRegion.ClearContents
            .Resize(lgr, UBound(PlgF, 2) + 1).Value = PlgF
        End With
    End With
End Sub

J'ai un peu allongé le code pour ne tester que sur le dernier bloc (ce qui diminue le nombre de tests global, donc plus rapide). Et le test en début de boucle n disparaît.

L'erreur que j'avais signalée pour un nombre de lignes de groupement supérieur à la moitié du nombre d'éléments initial ne se produit plus (elle devait être en fait provoquée par le test que j'ai supprimé). Si tu as 20 lignes au départ, tu peux taper un groupement par 10, 15, 20, 30... tu auras le tableau sur 2 colonnes tel que travaillé au départ (puisqu'il ne peut comporter que 10 lignes)

Par contre un nombre de lignes inférieur à 1 (0 ou nombre négatif) provoquera une erreur. Si tu le souhaites on peut la bloquer dès le départ, au moment de la saisie.

Cordialement.