supprimer tous les x sauf les premiers de chaque colonnes

Evelynetfrancois

XLDnaute Impliqué
Bonjour à toutes et tous
j aurais besoin d un coup de main en VBA
je voudrais supprimer tous les X d une feuille sauf les premiers de chaque colonne
j ai joint un fichier pour être plus clair
(Je ne suis pas dans l’urgence ....)
Un grand merci d’avance
Bonne journée a tous

evelynetfrancois
 

Pièces jointes

  • supprimer tous les x sauf les premiers de chaque colonne.xls
    16.5 KB · Affichages: 60

Modeste

XLDnaute Barbatruc
Re : supprimer tous les x sauf les premiers de chaque colonnes

Bonjour Evelynetfrancois,

Il faudrait être certain
- qu'il n'a a rien dans la plage en dehors des 'X' et des cellules vides
- qu'il n'y a rien sous le tableau
- que le tableau démarrera toujours en colonne A et ligne 1 (même si A1 est vide)
- qu'il y aura toujours au moins un 'X' dans chaque colonne
- qu'il n'y aura pas de colonne vide dans la plage

... bref, la question est de savoir si l'exemple donné est réellement représentatif de la situation réelle :)

Si la réponse à chaque question est positive, une façon de faire est de coller les lignes suivantes dans la fenêtre de code de la feuille concernée:
VB:
Sub gardeX()
For col = 1 To [A1].CurrentRegion.Columns.Count
    Cells(Application.Match("X", Columns(col), 0), col).Offset(1, 0).Resize(1000, 1).ClearContents
Next col
End Sub
Le '1000' dans le Resize sera à adapter en fonction du nombre maximum de cellules concernées (la hauteur de la plus longue colonne)

Si le volume à traiter est nettement plus conséquent, il faudra vraisemblablement s'y prendre autrement ... tu nous diras?
 

ROGER2327

XLDnaute Barbatruc
Re : supprimer tous les x sauf les premiers de chaque colonnes

Bonjour Evelynetfrancois, Modeste.


À essayer :​
Code:
Sub toto()
Dim i&, j&, tf As Boolean
Const c% = 88 ' = code ASCII de la lettre X.

  With Selection.CurrentRegion 'À adapter à la plage à traiter, en fonction du contexte réel

    If MsgBox("Voulez-vous supprimer les «" & Chr(c) & "» récurrents de chaque colonne de " & _
      .Address(0, 0) & " ?", vbYesNo, "?") = vbYes Then

      With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With

      For j = 1 To .Columns.Count
        tf = False
        For i = 1 To .Rows.Count
          With .Cells(i, j)
            If Len(.Value) = 1 Then
              If Asc(.Value) = c Then
                If tf Then .ClearContents Else tf = True
              End If
            End If
          End With
        Next
      Next

      With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With

    End If

  End With

End Sub


Bonne soirée.


ℝOGER2327
#8200


Jeudi 12 Gueules 143 (Saint Membre, compilateur - fête Suprême Quarte)
17 Pluviôse An CCXXIV, 7,5747h - lichen
2016-W05-6T18:10:46Z
 

Modeste

XLDnaute Barbatruc
Re : supprimer tous les x sauf les premiers de chaque colonnes

Bonsoir ROGER2327 :),

Je conviens bien volontiers que ta proposition offre l'avantage de remédier à 3 des préalables nécessaires que j'évoquais en préambule :D

Cependant, me gourre-je (gugurbitacée gue je zuis) ou faudrait-il recommander à l'utilisateur l'indispensable activation d'une quelconque cellule de la "plage en cours" avant l'exécution (de la macro)?

Par ailleurs, puisque l'occasion m'en est donnée, peux-tu éclairer ma lanterne sur un autre sujet qui me tarabuste depuis quelque temps déjà et qui fait que j'enrage? Pourtant, j'ai déjà tenté bien des choses: nettoyer consciencieusement mes lunettes, les ôter, me coller le nez tout contre l'écran, afficher la page avec un zoom de 250%, faire une capture d'écran et l'agrandir ensuite dans un logiciel de traitement d'image puis la faire pivoter ... et j'en passe! Enfin, je n'y tiens plus! Mais nom d'un chien (si je puis me permettre), qu'est-ce donc qui apparaît dans la moitié inférieure de ton avatar, quand il vire au rouge???? Je n'arrive pas à lire ... pitié! :(:mad: Ôte-moi cette épine du pied, illumine ma soirée et -au moins- tout le mois qui va suivre, épargne-moi la consultation chez un ophtalmo!
 

JCGL

XLDnaute Barbatruc
Re : supprimer tous les x sauf les premiers de chaque colonnes

Bonjour à tous,
salut aux amis,

Mon bon Luc : afin que tu puisses ne plus avoir d'épine dans le pied, que ta soirée soit illuminée ainsi que tout le mois qui va suivre....

Capture 1.png

A++
A+ à tous
 

Pièces jointes

  • Capture 1.png
    Capture 1.png
    5 KB · Affichages: 93

job75

XLDnaute Barbatruc
Re : supprimer tous les x sauf les premiers de chaque colonnes

Bonjour Evelynetfrancois, Modeste, Roger, jean-Claude,

Luc je ne comprends pas toutes tes questions, c'est pourtant bien clair et la solution simple :

Code:
Sub SupprimeX()
Dim P As Range, c As Range, i, prem As Range
Set P = [A1:O11] 'à adapter
For Each c In P.Columns
  i = Application.Match("X", c, 0)
  If IsNumeric(i) Then Set prem = Union(IIf(prem Is Nothing, c.Cells(i), prem), c.Cells(i))
Next
If Not prem Is Nothing Then P.Replace "X", "", xlWhole: prem = "X "
End Sub
Les cellules autres que "X" peuvent être vides ou contenir n'importe quoi.

Bonne fin de soirée.
 

Modeste

XLDnaute Barbatruc
Re : supprimer tous les x sauf les premiers de chaque colonnes

Bonjour le fil et le forum,

Mon bon Jean-Claude (tu sais que je t'aime, toi!? ;)) merci pour tes efforts et le temps passé ... mais le texte du bas m'est toujours aussi obscur :( Je crois déchiffrer "Écr. l'inf."? Je ferais peut-être mieux de jeter un œil (voire les deux ... à moins que ce ne soit le cerveau dont il faut que je me débarrasse :confused:)

Gérard :) ... ce ne sont pas des questions, ce sont des précautions oratoires couchées sur ... la page web :p
Ta "solution simple" tient compte de cas de figures différents de la mienne; moi, je m'économise le neurone, tant que je ne sais pas si la réalité sera plus compliquée que l'exemple ... ou pas :cool:
J'apprécie cependant ta solution, tout comme celle de Roger, puisqu'elles sont plus complètes!

Bon dimanche sous le soleil (je vous ai prévenus que ma vue baissait peut-être)
 

JCGL

XLDnaute Barbatruc
Re : supprimer tous les x sauf les premiers de chaque colonnes

Bonjour à tous,
Salut Luc,

« Ecr.l'inf. », abréviation de « Écrasons l'infâme » et parfois contracté en Ecrelinf, était une formule que le philosophe des Lumières Voltaire utilisait en conclusion de ses lettres. Cette formule invitait ainsi son correspondant à le joindre dans son combat contre l'obscurantisme, notamment religieux. Ce lien n'existe plus

A++ l'ami
A+ à tous
 

Si...

XLDnaute Barbatruc
Re : supprimer tous les x sauf les premiers de chaque colonnes

salut

Puisque tu en redemandes, Modeste :D, un autre exemple (sans X mais en gardant le XXXL même s’il me pèse) issu d’un autre type de recherche.
Code:
Sub XXXL()
  Dim n As Byte, R As Range
  For n = 1 To 15 'plage A1:O11
    Set R = Columns(n).Find("X", , , 1)
    If Not R Is Nothing Then R(2, 1).Resize(10).Replace "X", "", , 1
  Next
End Sub
Il est des circonstances qui permettent d’apprécier les dimanches sans lunettes de soleil ;).
Belle journée à tous
 

job75

XLDnaute Barbatruc
Re : supprimer tous les x sauf les premiers de chaque colonnes

Bonjour le fil, le forum,

Par curiosité j'ai enregistré le fichier en .xlsm et copié le tableau sur 15000 colonnes.

Alors ma macro du post #6 ne va pas, il faut décharger régulièrement la variable prem :

Code:
Sub SupprimeX()
Dim t, P As Range, decharge%, D As Range, c As Range, n%, i, prem As Range
t = Timer
Set P = [A1:VDX11] '15000 colonnes, à adapter
decharge = 50 'nombre de colonnes par décharge, à optimiser
Set D = P.Resize(, decharge) 'initialisation
Application.ScreenUpdating = False
For Each c In P.Columns
  n = n + 1
  i = Application.Match("X", c, 0)
  If IsNumeric(i) Then Set prem = Union(IIf(prem Is Nothing, c.Cells(i), prem), c.Cells(i))
  If n = decharge Then
    If Not prem Is Nothing Then D.Replace "X", "", xlWhole: prem = "X "
    Set D = D.Offset(, decharge)
    Set prem = Nothing
    n = 0
  End If
Next
If Not prem Is Nothing Then D.Resize(, n).Replace "X", "", xlWhole: prem = "X "
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub
Testé sur Win 8 - Excel 2013 :

- decharge = 1 => 3,8 s

- decharge = 10 => 2,3 s

- decharge = 50 => 2,3 s

- decharge = 100 => 2,4 s

- decharge = 200 => 3,2 s

- decharge = 500 => 8,6 s

- decharge = 1000 => 28 s

Nota : pour decharge = 1 il vaut mieux cette macro qui s'exécute en 3,5 s :

Code:
Sub SupprimeX()
Dim t, r As Range, i
t = Timer
Set r = [A1:VDX11] '15000 colonnes, à adapter
Application.ScreenUpdating = False
For Each r In r.Columns
  i = Application.Match("X", r, 0)
  If IsNumeric(i) Then r.Replace "X", "", xlWhole: r.Cells(i) = "X "
Next
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub
Fichier joint.

A+
 

Pièces jointes

  • supprimer tous les x sauf les premiers de chaque colonne(1).xlsm
    542.5 KB · Affichages: 53

Modeste

XLDnaute Barbatruc
Re : supprimer tous les x sauf les premiers de chaque colonnes

Salut tout le monde,

philosophe des Lumières
Ah ben c'est pour ça que je ne connaissais pas: ici, il y a bien longtemps qu'on a mouché les chandelles. On est passé du côté obscur. Merci d'avoir éclairé ma lanterne, Jean-Claude :)

Si... je ne (re-)demande rien, moi :rolleyes: ... mais je prends connaissances des alternatives. Sur ce, m'en vais piquer une tête dans la piscine, pendant que Gérard décharge! :eek:
 

Evelynetfrancois

XLDnaute Impliqué
Re : supprimer tous les x sauf les premiers de chaque colonnes

je vous remercie pour tout je vais tester ttout ca
sinon je voudrais tester toutes les celulles d une colonne de la 100 a la 2

For Each cell In Range("c2:c" & Range("c100").End(xlUp).Row)
mais ca ne marche pas !
merci d avance pour tout
tres bonne journée a tous
evelyne et francois
 

Discussions similaires

Réponses
22
Affichages
691

Statistiques des forums

Discussions
311 736
Messages
2 082 026
Membres
101 876
dernier inscrit
JULIEN21370