Comment supprimer par VBA une valeur donnée dans un tableau structuré

Bonsoir,

tout est dans le titre : j'ai un tableau structuré, et je voudrais supprimer tous les "18" par un code VBA.
Je voulais utiliser le "SpecialCells" mais je crois qu'il ne prend pas en compte une valeur donnée dans les cellules, ou bien je n'y suis pas arrivé.

Merci à vous de vous pencher sur ce petit problème.
Je pensais faire une boucle ou double boucle, mais avec le specialcells je pensais pouvoir le faire de façon "ligne unique".

Un fichier structure bien que la question soit simple :

@ bientôt

LouReeD

Hello LouReed

Sub ClearEnBoucle()
    Dim lo As ListObject
    Dim cel As Range
    Dim searchValue As String

    searchValue = "18"
    Set lo = ActiveSheet.ListObjects("Tableau1")

    For Each cel In lo.DataBodyRange
        If cel.Value = searchValue Then cel.ClearContents
    Next cel
End Sub

Sub ClearOneShot()
    Dim lo As ListObject
    Dim searchValue As String

    searchValue = ""
    Set lo = ActiveSheet.ListObjects("Tableau1")

    lo.DataBodyRange.Replace What:=searchValue, Replacement:="18", _
        LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
End Sub

Faudrait sécuriser si .databodyrange is nothing ...

Et bien tomato : bravo !

En une seule ligne un peu comme specialcells et en ne respectant pas la définition des variables :

Range("Tab").Replace What:="3", Replacement:=""

Merci encore. Je cherche également la possibilité de copier le tableau "à l'horizontal", la colonne Ent^te1 se trouve à la droite et celle de droite à gauche et ainsi de suite, une idée ?

Je l'ai fait dans l'autre sens en créant une colonne avec des valeurs chronologique, du coup en faisant un tri du plus petit au plus grand ou inversement cela renverse en vertical les données, mon idée est de faire la même chose en horizontal.

@ bientôt

LouReeD

bonjour LouReeD, salut tomato,

je n'ai pas bien compris le but, c'est échanger la séquence des colonnes ?

Sub LouReeD()
     'Application.ScreenUpdating = False 'pour accèlerer la macro
     With Range("Tableau1").ListObject       'votre tableau
          If .ListColumns.Count > 1 Then     'min 2 colonnes
               .ListColumns.Add 1            'insérer une nouvelle colonne "1"
               ptr = 1                       'pointer
               For i1 = .ListColumns.Count To 1 Step -1     'boucler les colonnes
                    .ListColumns(i1).Range.Cut .ListColumns(ptr).Range     'déplacer cette colonne vers la colonne vide à gauche
                    ptr = ptr + 1            'incrementer pointer
                    .ListColumns(ptr).Range.Cut .ListColumns(i1).Range     'déplacer colonne suivante à gauche vers la colonne vide à droite
                    If ptr >= i1 - 2 Then    'si les 2 colonnes se rencontrent au milieu
                         .ListColumns(ptr).Range.Delete     'supprimer la colonne vide
                         Exit For            'FIN
                    End If
               Next
          End If
     End With
End Sub

Sub LouReeD2()
     With Range("Tableau1").ListObject       'votre tableau
          If .ListRows.Count > 0 Then        'min 1 ligne
               .DataBodyRange.Replace "18", "", xlWhole
          End If
     End With
End Sub

Bonjour à tous,

Je réponds à la question de permutation des colonnes, voici ma proposition avec 1 seule boucle.

Sub InverserColonnesTableau()
    Dim f1 As Worksheet
    Dim Tabl As ListObject
    Dim DerCol As Long, i As Long
    Set f1 = Sheets("Feuil1")
    Set Tabl = f1.ListObjects("Tableau1")

    DerCol = Tabl.ListColumns.Count
    For i = DerCol - 1 To 1 Step -1
        Tabl.ListColumns(i).Range.Cut
        Tabl.ListColumns(DerCol).Range.Offset(0, 1).Insert Shift:=xlToRight
    Next i
End Sub

Cdlt

Bonjour à vous deux !

Je vais prendre le code d'Arturo83 qui m'est visuellement plus accessible et dont j'ai pu le modifier simplement à mon besoin car toutes les colonnes devaient être inversée sauf la première de gauche... désolé de ne pas avoir donné cette information.

@ bientôt

LouReeD

Re bonjour,

Au final j'ai abandonné les codes de "copier/insérer/coller" pour arriver au résultat voulu.
En effet ce tableau à modifier sert de base pour une copie des données dans une autre feuille.
J'ai dons créé un deuxième tableau identique avec pour information dans les cellules des formules qui vont chercher "à l'envers" les données du tableau de travail.
lorsque j'ai besoin d'avoir les colonnes inversées dans le tableau de travail, il me suffit de faire un copier/coller des valeurs du tableau inversées sur le tableau de travail. résultat j'ai bien mes colonnes inversées, et sur le tableau de formule je me retrouve avec le tableau d'origine.

Du coup mon tableau sur ma feuille "finale" n'est qu'une recopie des données du tableau de travail et c'est quasi instantané.

Et vu la "simplicité" du système, je crois que pour l'inversion des lignes je vais faire à l'identique plutôt que de jouer sur une colonne avec un tri chrono ou pas.
cela m'évite d'avoir une colonne inutile dans le tableau au niveau des données.

Merci encore à vous pour vos solutions, ces dernières m'ayant indirectement orienté vers celle que je vais utiliser.

@ bientôt

LouReeD

Voilà,

en fait le projet est de refaire ArkaLouReeD Light ! en plus optimisé !
Maintenant que je sais où je veux aller, je cherche à améliorer les différentes procédures pour en accélérer le fonctionnement.
Il y a des capsules qui permettent de retourner le tableau de jeu en vertical, mais avec des boucles en X et Y, et même si cela est rapide, je pense que la technique d'une copie d'un tableau de travail est plus rapide encore, du coup de part la simplicité de cette dernière je peux facilement faire cette bascule de tableau en horizontal, verticale et à 180°.

C'est comme pour la capsule qui supprime soit les briques Noires ou les briques Or, la technique de tomato me permet "simplement" d'arriver au résultat et c'est rapide également.

Je vous met ici le début de ce nouveau projet :

Je pense que pour chaque optimisation de code je viendrais vous demander de l'aide si je bute sur un point particulier.

@ bientôt

LouReeD

je vois que des forumes "indirect" dans la feuille "travail"

Tu veux quoi exactement pour le moment, je ne comprends pas et je ne connais pas ce jeu ...

Oui j'ai mis des INDIRECT afin de rendre la copie de la formule plus simple !
Peut-être me faudrait il du temps pour les écrire tout simplement avec =A2.

Sinon pour le reste le fichier fonctionne. C'est une ultime reprise du jeu Arkanoïd sorti en 1986 dont j'ai fait deux clones :
ArkaLouReeD avec animations, musiques et bruitages
ArkaLouReeD Light ! en version "allégée" pour des ordinateurs moins puissants.

Ils sont tous les deux téléchargeables sur le site, mais je me replonge dans le code et ma façon de faire pour essayer de le rendre encore plus rapide.
La version ici qui fait tourner le tableau sur le plateau de jeu me conviens.

Donc non il n'y a plus de demande, c'était pour fournir le "pourquoi du comment".
Je prends note de la remarque des formules en INDIRECT que je prendrais le temps de mettre en formules simples. Cela sera moins lourd bien évidemment.

@ bientôt

LouReeD

Je n'ai pas compris la partie : la colonne 1 ne bouge pas mais tu pourras adapter facilement le code suivant qui sera plus performant et instantané car sans lecture/écriture ni recalcule de formules parfois bien gourmandes...

C'est marqué mais le premier booléen inverse (ou pas) les colonnes, le second inverse (ou pas) les lignes

Sub InverserTableau(ByVal InverserColonnes As Boolean, ByVal InverserLignes As Boolean)
Dim ws As Worksheet
Dim lo As ListObject
Dim colCount&, rowCount&
Dim i&, j&
Dim srcCol&, srcRow&
Dim header() As Variant
Dim body() As Variant

    ' Définir la feuille et le tableau
    Set ws = ActiveSheet
    Set lo = ws.ListObjects(1)

    colCount = lo.ListColumns.Count
    rowCount = lo.ListRows.Count

    ' 2 tbl : header et body
    ReDim header(1 To 1, 1 To colCount)
    ReDim body(1 To rowCount, 1 To colCount)

    ' Remplissage
    For i = 1 To colCount
        srcCol = IIf(InverserColonnes And colCount > 1, colCount - i + 1, i)

        ' Header
        header(1, i) = lo.HeaderRowRange.Cells(1, srcCol).Value

        ' Body
        For j = 1 To rowCount
            srcRow = IIf(InverserLignes And rowCount > 1, rowCount - j + 1, j)
            body(j, i) = lo.DataBodyRange.Cells(srcRow, srcCol).Value
        Next j
    Next i

    ' Réinjecter dans le tableau
    lo.HeaderRowRange.Value = header
    lo.DataBodyRange.Value = body
End Sub

Sub sens_dessus_dessous()
Call InverserTableau(True, True)
End Sub

Espérant avoir répondu à tes attentes

J'ai compris ta demande (enfin je crois) :

Sub InverserTableau(ByVal InverserColonnes As Boolean, ByVal InverserLignes As Boolean)
Dim ws As Worksheet
Dim lo As ListObject
Dim colCount&, rowCount&
Dim i&, j&
Dim srcCol&, srcRow&
Dim header() As Variant
Dim body() As Variant

    ' Définir la feuille et le tableau
    Set ws = ActiveSheet
    Set lo = ws.ListObjects(1)

    With lo
        If .DataBodyRange Is Nothing Then Exit Sub

        colCount = .ListColumns.Count
        rowCount = .ListRows.Count

        ' 2 tbl miroir : header et body
        ReDim header(1 To 1, 1 To colCount)
        ReDim body(1 To rowCount, 1 To colCount)

        ' Remplissage du miroir
        For i = 1 To colCount
            If i = 1 Then
                ' Première colonne figée totalement
                header(1, 1) = .HeaderRowRange(1, 1).Value
                For j = 1 To rowCount
                    body(j, 1) = .DataBodyRange(j, 1).Value
                Next j
            Else

                ' Colonnes inversables
                srcCol = IIf(InverserColonnes, colCount - i + 2, i)

                ' Header
                header(1, i) = .HeaderRowRange(1, srcCol).Value

                ' Body
                For j = 1 To rowCount
                    srcRow = IIf(InverserLignes, rowCount - j + 1, j)
                    body(j, i) = .DataBodyRange(srcRow, srcCol).Value
                Next j
            End If
        Next i

        ' Réinjecte dans le tableau
        .HeaderRowRange.Value = header
        .DataBodyRange.Value = body
    End With
End Sub

Utiliser cette procédure avec un appel :

Sub sens_dessus_dessous()
Call InverserTableau(True, True) 'true = inverser : colonnes, lignes
End Sub

re,

je vois que presque tout le monde a à peu près le même idée.

Chez moi, c'est une fonction personalisée de quelque lignes dans la cellule BA2. Si on veut inverser les lignes, cela ne change pas beaucoup.

Function F_InverseColonnes(Plage As Range)
     Dim aCol, aLig, t
     With Plage                              'votre plage
          aLig = Evaluate(Replace("row(offset(a1,,,#))", "#", .Rows.Count))
          aCol = Evaluate(Replace("transpose(#+1-row(offset(a1,,,#)))", "#", .Columns.Count))
          F_InverseColonnes = Application.Index(.Value2, aLig, aCol)
     End With
End Function

Bonsoir,

merci à vous deux d'avoir travaillé la dessus une fois de plus, mais je crois que je vais simplement faire des formule de report de valeur de cellule du type = A2, bien qu'il y ait des recalculs, ces derniers peuvent -être arrêtés et mis en marche à la demande.

Sur le fichier que j'ai fournis on voit qu'avec des INDIRECT le résultat est rapide ! On initialise le tableau et après que ce soit avec le bouton vertical, horizontal, rotation ou même le tassement, le résultat est instantané. Et pour moi au niveau programmation c'est beaucoup plus simple !

Merci encore.

@ bientôt

LouReeD

re,

"indirect" est une formule volatile, elle se récalcule toujours, même si la cellule concernée n'a pas modifiée, donc c'est une des choses à vérifier si tu dis que ton fichier est lent. Donc moi je diriais, supprimer toutes ces formules et avec une simple fonction personalisée avec 3 variables, type f_Inverser(Plage, bLignes, bColonnes) dont bLignes et bColonnes sont 2 valeurs boolean pour indiquer si vous voulez inverser les lignes et/ou colonnes, vous auriez le même résultats au moment nécessaire.

Peux-tu jouer ce jeu sans la feuille "travail" et vérifier si le fichier est plus vite ?

Bonsoir à vous trois !

Je vous joins le début de mon travail sur la nouvelle version d'ArkaLouReeD Light !
Le fichier :

10brickblaster.xlsm (85.09 Ko)

Là pour les tests les capsules bonus sont remplacées par des boutons. Le fonctionnement : on initialise le jeu, puis on clic sur lancer la balle, au cours du jeu on peut simuler un bonus de destruction d'un type de brique, la rotation vertical, horizontal du tableau ou bien sa rotation de 90° !

J'ai donc pris l'option des tableaux avec formule simple de référence de cellule pour calculer "en live" les tableaux correspondants à ces diverses rotations.
on voit que l'on voit pas le temps de calcul.

Merci encore à vous de vous être penchés sur mes "problèmes", je ne garde donc que le code de modification de valeur d'une donnée dans une plage de cellule fourni par tomato.

@ bientôt

LouReeD

Rechercher des sujets similaires à "comment supprimer vba valeur donnee tableau structure"