1. Ce site utilise des "témoins de connexion" (cookies) conformes aux textes de l'Union Européenne. Continuer à naviguer sur nos pages vaut acceptation de notre règlement en la matière. En savoir plus.

Supprimer les cellules vides d'un tableau et remonter les informations vers le haut

Discussion dans 'Forum Excel' démarrée par bennp, 7 Décembre 2017.

  1. bennp

    bennp XLDnaute Nouveau

    Inscrit depuis le :
    26 Décembre 2015
    Messages :
    30
    "J'aime" reçus :
    0
    Bonjour à tous,

    je souhaiterais supprimer automatiquement les cellules d'un tableau et remonter chaque informations vers le haut sans que ce soit la ligne entière qui remonte (voir exemple). et garder les noms correspondant de la 1ère colonne.

    les 2 premières lignes seraient :

    Foot - Ballon - rond - blanc
    Foot - Crampon - long - vert

    et du coup la dernière ligne :

    Baseball - batte - longue - orange

    quelqu'un aurait une idée pour le faire ?

    merci à tous
     

    Pièces jointes:

  2. bennp

    bennp XLDnaute Nouveau

    Inscrit depuis le :
    26 Décembre 2015
    Messages :
    30
    "J'aime" reçus :
    0
    Bon,

    j'ai réussi à me débrouiller

    Sub remonter()
    Range("C3:C92").Select
    Selection.Copy
    Range("C3:C92").Offset(-1, 0).Activate
    ActiveSheet.Paste

    Range("D3:D92").Select
    Selection.Copy
    Range("D3:D92").Offset(-2, 0).Activate
    ActiveSheet.Paste

    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(i, 2) = "" Then
    Cells(i, 1).EntireRow.Delete
    End If
    Next i

    End Sub

    peut-être que quelqu'un peut essayer d’alléger le code, je vais avoir beaucoup de macro comme ça

    merci
     
  3. cp4

    cp4 XLDnaute Occasionnel

    Inscrit depuis le :
    7 Novembre 2015
    Messages :
    109
    "J'aime" reçus :
    7
    Bonjour,
    Code (Visual Basic):
    Option Explicit

    Sub remonter()
        Dim i As Integer
        Range("C3:C92").Copy Range("C3:C92").Offset(-1, 0)
        Range("D3:D92").Copy Range("D3:D92").Offset(-2, 0)

        For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
            If Cells(i, 2) = "" Then
                Cells(i, 1).EntireRow.Delete
            End If
        Next i

    End Sub
     
  4. bennp

    bennp XLDnaute Nouveau

    Inscrit depuis le :
    26 Décembre 2015
    Messages :
    30
    "J'aime" reçus :
    0
    Super merci,

    est'il possible de faire la même chose en utilisant les noms de colonnes ? Par exemple remonter Tableau1[forme] d'une cellule vers le haut.

    Je demande ça car la taille de mon tableau varie et si j'importe un tableau plus petit que la ligne 92, j'ai un message d'erreur ! Mon tableau aura toujours le même nom et les mêmes noms de colonnes.

    Merci de votre aide
     

    Pièces jointes:

  5. cp4

    cp4 XLDnaute Occasionnel

    Inscrit depuis le :
    7 Novembre 2015
    Messages :
    109
    "J'aime" reçus :
    7
    comme ceci petit ou grand tableau, peu importe on se réfère aux nombres de lignes de la colonne A
    Code (Visual Basic):
    Option Explicit

    Sub remonter()
        Dim i As Integer, dl As Long
        dl = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
        With Feuil1
        .Range("C3:C" & dl).Copy .Range("C3:C" & dl).Offset(-1, 0)
        .Range("D3:D" & dl).Copy .Range("D3:D" & dl).Offset(-2, 0)

        For i = dl To 1 Step -1
            If .Cells(i, 2) = "" Then
                .Cells(i, 1).EntireRow.Delete
            End If
        Next i
    End With
    End Sub
     
  6. thebenoit59

    thebenoit59 XLDnaute Accro

    Inscrit depuis le :
    18 Juillet 2013
    Messages :
    1323
    "J'aime" reçus :
    123
    Bonjour bennp.
    Bonjour cp4.

    Une autre solution avec tableaux virtuels.

    Code (Visual Basic):

    Option Explicit

    Sub regroupement()
    Dim a1(), a2()
    Dim i&, i2&, j As Byte

    With Sheets(1)
        a1 = .Range("A2:D" & .Cells.Find("*", , , , xlByRows, xlPrevious).Row).Value
    End With

    ReDim a2(1 To UBound(a1), 1 To UBound(a1, 2))
    For i = 1 To UBound(a1)
        If Not a1(i, 2) = "" Then
            i2 = i2 + 1
            a2(i2, 1) = a1(i, 1)
            a2(i2, 2) = a1(i, 2)
            a2(i2, 3) = a1(i + 1, 3)
            a2(i2, 4) = a1(i + 2, 4)
            i = i + 2
        End If
    Next i

    With Sheets(1)
        .[a1].CurrentRegion.Offset(1).Clear
        .[a2].Resize(i2, UBound(a2, 2)) = a2
    End With
    End Sub

     
     
    cp4 aime votre message.
  7. cp4

    cp4 XLDnaute Occasionnel

    Inscrit depuis le :
    7 Novembre 2015
    Messages :
    109
    "J'aime" reçus :
    7
    Bonjour thebenoit59,

    impeccable pour un nombre de lignes important.
    je t'envie car je ne maîtrise pas les tableaux.

    bonne journée.
     
  8. thebenoit59

    thebenoit59 XLDnaute Accro

    Inscrit depuis le :
    18 Juillet 2013
    Messages :
    1323
    "J'aime" reçus :
    123
    A force d'entraînement tu y arriveras, c'est certain.
     
  9. cp4

    cp4 XLDnaute Occasionnel

    Inscrit depuis le :
    7 Novembre 2015
    Messages :
    109
    "J'aime" reçus :
    7
    Merci pour les encouragements thebenoit59.
    Bon dimanche.
     
  10. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Bonsoir bennp, cp4, thebenoit59,

    Le VBA n'est pas indispensable, manuellement ce n'est pas très compliqué :

    - commencer par supprimer les cellules C2 et D2: D3 pour aligner les textes

    - trier le tableau sur la colonne B pour placer les cellules vides en bas

    - sélectionner la colonne B et touche F5 => Cellules => cellules vides => OK

    - clic droit sur la sélection => Supprimer => ligne entière

    - pour terminer trier le tableau sur la colonne A.

    Notez que les formats des cellules sont conservés.

    A+
     
    Staple1600 aime votre message.
  11. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Re,

    Si l'on veut absolument automatiser les opérations précédentes :
    Code (Text):
    Sub Tris()
    Application.ScreenUpdating = False
    With Range("A1").CurrentRegion
      .Cells(2, 3).Delete xlUp: .Cells(2, 4).Resize(2).Delete xlUp
      .Sort .Columns(2), Header:=xlYes 'pour placer les cellules vides en bas
      .Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      .Sort .Columns(1), Header:=xlYes
      With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
    End With
    End Sub
    C'est un peu moins rapide que la méthode de thebenoit59 mais comme je l'ai dit les formats sont conservés.

    A+
     
  12. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Re,

    Pour tester sur Win 10 Excel 2013 j'ai copié la plage A2: D44 sur A45: D1048556.

    La macro de thebenoit59 s'exécute en 5 secondes, la mienne en 9 secondes.

    Bonne nuit.
     
  13. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Bonjour le forum,

    Si les textes en colonnes B C D sont dans un ordre quelconque c'est bien sûr plus compliqué.

    Voyez les fichiers joints et ces macros :
    Code (Text):
    Sub Regroupement_sans_formats()
    Dim t, nlig&, ncol%, t1, i&, j%, n&, kmax&, k&
    With [A1].CurrentRegion
      t = .Value2: nlig = UBound(t): ncol = UBound(t, 2)
      ReDim t1(1 To nlig, 1 To ncol)
      For i = 1 To nlig
        For j = 2 To ncol
          If t(i, j) <> "" Then Exit For
        Next j
        If j <= ncol Then
          n = n + 1
          t1(n, 1) = t(i, 1)
          kmax = 0
          For j = 2 To ncol
            For k = i To nlig
              If t(k, j) <> "" Then
                t1(n, j) = t(k, j)
                If k > kmax Then kmax = k
                Exit For
              End If
            Next k
          Next j
          i = kmax
        End If
      Next i
      Application.ScreenUpdating = False
      If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
      .Rows(2).Resize(n).Interior.ColorIndex = xlNone 'efface les couleurs
      .Resize(n) = t1
      .Rows(n + 1).Resize(Rows.Count - n - .Row + 1).Delete xlUp 'RAZ en dessous
      With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
    End With
    End Sub

    Sub Regroupement_avec_formats()
    Application.ScreenUpdating = False
    With [A1].CurrentRegion
      If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
      .Columns(1).EntireColumn.Insert
      .Columns(0).NumberFormat = "General": .Columns(0) = "=1/ISBLANK(RC[2])": .Columns(0) = .Columns(0).Value
      .Columns(0).Resize(, 3).Sort .Columns(0), xlDescending, Header:=xlYes 'pour placer les cellules vides en bas
      .Columns(0).EntireColumn.Delete
      .Columns(3).EntireColumn.Insert
      .Columns(3).NumberFormat = "General": .Columns(3) = "=1/ISBLANK(RC[1])": .Columns(3) = .Columns(3).Value
      .Columns(3).Resize(, 2).Sort .Columns(3), xlDescending, Header:=xlYes 'pour placer les cellules vides en bas
      .Columns(3).EntireColumn.Delete
      .Columns(4).EntireColumn.Insert
      .Columns(4).NumberFormat = "General": .Columns(4) = "=1/ISBLANK(RC[1])": .Columns(4) = .Columns(4).Value
      .Columns(4).Resize(, 2).Sort .Columns(4), xlDescending, Header:=xlYes 'pour placer les cellules vides en bas
      .Columns(4).EntireColumn.Delete
      On Error Resume Next 'si aucune SpecialCell
      .Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
    End With
    End Sub
    Edit : ajouté If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée

    Testé sur tableaux en A1: D1048556 :

    - Regroupement_sans_formats => 6 secondes

    - Regroupement_avec_formats => 35 secondes.

    Bon dimanche.
     

    Pièces jointes:

    Dernière édition: 10 Décembre 2017 à 13:14

Partager cette page