Compacter un tableau avec VBA

Résolu
Bonjour,

Je voudrais compacter les valeurs de mon tableau le plus a gauche possible
Je n'ai pas le droit de joindre un fichier
mais en gros ce que je veux c'est que sur une ligne au lieu d'avoir par exemple mes valeures

X 1 X 2 X 3 X 4
je les veux
1 2 3 4 X X X X
ca fait 4 heures que je suis bloquer sur ce probleme a cause d'un simple bouton
merci a vous

6 réponses

  1. Contributeur
    Bonjour,

    Une macro qui devrait mettre moins de 30 min : https://www.cjoint.com/?DFfqY3OSYLI
    Comme apparemment tu as plusieurs feuilles concernées c'est une macro unique dans Thisworkbook.
    Elle se lance par un double-clic en J2. Ajoute un contrôle du nom des feuilles, qu'elle ne se lance que sur les feuilles concernées.

    eric
    1
    1. Bonjour

      Pas très clair.
      Tu peux joindre un exemple bidon (avec la même structure et quelques lignes) de ce que tu veux obtenir, au format excel 2003 sur cjoint.com et mets le lien obtenu à ton prochain message

      Cdlmnt
      0
      1. Bonjour désole de ne pas avoir répondu plus tot je n'etais plus sur omn lieu de travail et je n'avais plus excel sous la main
        https://www.cjoint.com/?DFeiPkaP35X
        voila en gros ce que je veut qu'un bouton me fasse
        0
    2. Désolé, mais je t'ai demandé un fichier au format excel 2003 (fichier/enregistrer sous/Type/ ... xls)
      0
      1. Bonjour
        il faut faire 2 boucle

        Sub test()
        Nlig = Range("B" & Rows.Count).End(xlUp).Row
        For L = 3 To Nlig
        Col = 10
        For C = 3 To 7
        If Cells(L, C).Value <> "" Then
        Cells(L, Col).Value = Cells(L, C).Value
        Col = Col + 1
        End If
        Next
        Next
        End Sub

        A+
        Maurice
        0
        1. Bonjour

          A toi de modifier les valeurs des constantes selon ta configuration

          Option Explicit

          Const NF = "Feuil1"
          Const lideb = 1
          Const codeb = 1

          Public Sub Kompacte()
          Dim lifin As Long, li As Long, co As Long, cofin As Long, coco As Long
          With Sheets(NF)
          lifin = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
          For li = lideb To lifin
          cofin = .Cells(li, Columns.Count).End(xlToLeft).Column
          coco = codeb
          For co = codeb To cofin
          If .Cells(li, co) <> "" Then
          .Cells(li, coco) = .Cells(li, co)
          .Cells(li, co) = ""
          coco = coco + 1
          End If
          Next co
          Next li
          End With
          End Sub

          Cdlmnt
          0
          1. Ok merci je vais essayer ca tout de suite.
            Désole pour le fichier excel j'ai pas trop compris pourquoi il me la pas mis en 2003 ce lien devrait etre bon.
            https://www.cjoint.com/?DFfoaBkTrPE
            0
          2. Les Vba ne sont pas du tout comme ce a quoi je m'attendais enfait peu etre que si j'expliquais un peu mieu ce que je veux ca serait mieu
            je voudrais que si la case de gauche est vide il me decale ma valeure dedan ceci pour 20 lignes et 30 colonnes
            j'ai utiliser un copier coller si avec une boucle je met presque 30 minutes a tout decaler si il y a beaucoup de valeures
            0
        2. C'est exactement ce qu'il me faut !
          il est instantané
          par contre j'aimerais qi'il soit sur un bouton comment j'ajoute la macro au bouton?
          et pourquoi la colonne S n'est pas decalée ?
          0
          1. Contributeur
            Bonjouir,

            pourquoi la colonne S n'est pas decalée ?

            Erreur de ma part, corrigé

            par contre j'aimerais qi'il soit sur un bouton
            Si tu préfères, dans ce cas il faudra mettre le code sur chaque bouton :
                Dim pl As Variant, lig As Long, col As Long, col2 As Long, i As Long
                Const plage As String = "B5:S34"
                
                pl = Range(plage).Value
                If Target.Address = "$J$2" Then
                    Cancel = True
                    For lig = 1 To UBound(pl, 1)
                        For col = 1 To UBound(pl, 2)
                            If pl(lig, col) = "" Then
                                col2 = col
                                Do
                                    col2 = col2 + 1
                                    If col2 > UBound(pl, 2) Then Exit For
                                Loop Until pl(lig, col2) <> ""
                                i = 0
                                For col2 = col2 To UBound(pl, 2)
                                    pl(lig, col + i) = pl(lig, col2)
                                    pl(lig, col2) = ""
                                    i = i + 1
                                Next col2
                            End If
                        Next col
                    Next lig
                    Range(plage) = pl
                End If


            eric
            0