Suppression de ligne en fonction de cellule blanche dans une colonne

Bonjour,

J'espère que vous allez bien, alors voilà je suis bloqué dans le cas suivant :

J'ai deux colonnes (A et B) ; la colonne B comporte des cellules (avec du texte) de couleur verte et blanche.

J'aimerai un code VBA pour supprimer toutes les lignes pour lesquelles, elles ont une cellules blanche (avec du texte) dans la colonne B ;

Je n'ai malheureusement pas d'exemple à fournir j'en suis navré

Merci d'avance pour le coup de main,

Cordialement,

Roijio.

Bonjour,

Voici un premier essai :

sub test()
dim rsupp as range
with activesheet
    dl = .cells(.rows.count, 2).end(xlup).row
    for i = 1 to dl
        with .cells(i, 2)
            if .value <> "" and .interior.color = xlnone then
                if rsupp is nothing then set rsupp = .offset(, -1).resize(, 2)
                set rsupp = union(rsupp, .offset(, -1).resize(, 2))
            end if
        end with
    next i
end with
if not rsupp is nothing then rsupp.delete xlshiftup
end sub

Cdlt,

Bonjour,

Merci beaucoup de votre réponse malheureusement cela ne fonctionne pas je lance la macro et cela ne fait rien ;

J'ai crée un exemple pour vous montrer à quoi ressemble mes colonnes;

Merci encore,

Cordialement.

4exemple.xltm (9.08 Ko)

Oui, je pense que c'est à cause de la couleur...

Et avec ce code :

sub test()
dim rsupp as range
with activesheet
    dl = .cells(.rows.count, 2).end(xlup).row
    for i = 1 to dl
        with .cells(i, 2)
            if .value <> "" and .interior.colorindex = 2 then
                if rsupp is nothing then set rsupp = .offset(, -1).resize(, 2)
                set rsupp = union(rsupp, .offset(, -1).resize(, 2))
            end if
        end with
    next i
end with
if not rsupp is nothing then rsupp.delete xlshiftup
end sub

Est-ce que ça marche ?

Salut Roijio, 3GB

@3GB, il est passé par une MFC, donc si je ne dit pas de bêtise, plutôt:

Sub test()
Dim rsupp As Range
With ActiveSheet
    dl = .Cells(.Rows.Count, 2).End(xlUp).Row
    For i = 1 To dl
        With .Cells(i, 2)
            If .Value <> "" And .DisplayFormat.Interior.Color = 16777215 Then
                If rsupp Is Nothing Then Set rsupp = .Offset(, -1).Resize(, 2)
                Set rsupp = Union(rsupp, .Offset(, -1).Resize(, 2))
            End If
        End With
    Next i
End With
If Not rsupp Is Nothing Then rsupp.Delete xlShiftUp
End Sub

Bonjour à tous,

Tu ne souhaites conserver que les lignes dont les cellules B contiennent "1" ?

Une variante.....A tester:

Sub Macro1()
 Dim dl As Long, tablo, tabloR(), k As Long, i As Long

  With Sheets("Feuil1")
   dl = .UsedRange.Rows.Count
   tablo = .Range("A3:B" & dl)

   If dl < 3 Then Exit Sub

    k = 0
    For i = 1 To UBound(tablo, 1)
     If tablo(i, 2) <> "" And tablo(i, 2) Like "*1*" Then
      ReDim Preserve tabloR(1 To 2, 1 To k + 1)
       For j = 1 To 2
        tabloR(j, 1 + k) = tablo(i, j)
       Next j
    k = 1 + k
     End If
    Next i
      .Range("A3:B" & dl).ClearContents
      On Error Resume Next
     .Range("A3").Resize(UBound(tabloR, 2), 2) = Application.Transpose(tabloR)
   End With
End Sub
3exemple2.xlsm (13.80 Ko)

Cordialement,

Merci beaucoup pour vos réponses

@3GB j'ai essayé les macros mais sans réels succès peut être que je me trompe lors des manipulations ...

@Numéro 2 la macro marche nickel pour mon premier cas (Feuil2 de l'exmple) mais ne marche pas pour mon deuxième cas (Feuill1) pourtant cela reste la même manipulation je ne comprends pas pourquoi car il m'affiche une erreur...

17tableau-cmr.xlsm (57.14 Ko)

@xorsankukai C'est exactement ça merci je vais l'essayer sur mon tableau final.

Mais en fait j'ai deux tableau à faire à partir de mon tableau de base :

- Un regroupant les cases avec uniquement des 1 ou des 1 & des 2, donc qui supprime les lignes qui contiennent des cases avec uniquement des 2 en colonne B ;

- Un autre regroupant uniquement les cases avec des 2, donc qui supprime les lignes qui contiennent des cases avec uniquement des 1 et des 1 & 2.

Je n'y connais pas grand chose en VBA mais ça à l'air très compliqué de faire cela par un code, c'est pour cela que j'ai préféré posé une condition avec une couleur concernant les cases que je souhaite garder.

Merci d'avance;

Cordialement;

Roijio.

@Numéro 2 la macro marche nickel pour mon premier cas (Feuil2 de l'exmple) mais ne marche pas pour mon deuxième cas (Feuill1) pourtant cela reste la même manipulation je ne comprends pas pourquoi car il m'affiche une erreur...

regarde en B7228

Re,

Merci pour ton retour,

Mais en fait j'ai deux tableau à faire à partir de mon tableau de base :

- Un regroupant les cases avec uniquement des 1 ou des 1 & des 2, donc qui supprime les lignes qui contiennent des cases avec uniquement des 2 en colonne B ;

- Un autre regroupant uniquement les cases avec des 2, donc qui supprime les lignes qui contiennent des cases avec uniquement des 1 et des 1 & 2.

Un essai à titre "expérimental".....

  • Un tableau avec uniquement les 2
  • Un tableau avec uniquement les 1 & les 2
  • Un tableau avec uniquement les 1
2exemple3.xlsm (26.97 Ko)
2exemple3bis.xlsm (26.63 Ko)

CTRL + e pour exécuter la macro

Cordialement,

Re, Salut Numéro 2, Salut xorsankukai ,

Désolé, comme l'a fait remarquer Numéro 2, la macro bloquait à cause des MFC. Mais de toute manière, il est risqué et plus compliqué de coder sur des couleurs.

Voici un essai, inspiré de la première macro de xorsankukai, avec un code qui conserve :

- pour la feuille 1 : les lignes contenant des 1 ;

- pour la feuille 2 : les lignes contenant des 2 et ne contenant pas de 1.

Sub LancerSupp()
dim tcritok, tcritnok 'edit xorsankukai :)
tcritok = array("1", "2")
tcritnok = array("|~|", "1")
for i = 1 to 2
    Supprime sheets(i), tcritok(i - 1), tcritnok(i - 1)
next i
end sub

Sub Supprime(Feuille as worksheet, critok, critnok)
With Feuille
    dl = application.max(.cells(.rows.count, 2).end(xlup).row, 3)
    with .Range("A3:B" & dl)
        t = .value
        For i = lbound(t) To uBound(t)
            If t(i, 2) Like "*" & critok & "*" and not t(i, 2) like "*" & critnok & "*" Then
                n = n + 1    
                For k = lbound(t, 2) to ubound(t, 2)
                    t(n, k) = t(i, k)
                Next k
            End If
        Next i
        .ClearContents
        if n > 0 then .Resize(n, ubound(t, 2)) = t
    end with
End With
End Sub

Cdlt,

Salut 3GB,

En voulant tester ton code (qui est super au passage, ), je rencontre une erreur.....

Je loupe quelque chose ?

capture

C'est toujours un plaisir de te lire,

Amitiés,

Salut xorsankukai,

Merci de ta vigilance ! Oui, il y a une incompatibilité de type ! J'ai édité le code à l'instant qui ne devrait plus bugger, du moins à cet endroit...

En fait, j'ai défini des paramètres de type string dans la macro Supprime et je voulais définir mes tableaux en string pour éviter un blocage à la compilation mais il est alors impossible de les affecter avec la fonction array apparemment...

J'ai donc laissé les paramètres en variant.

A bientôt,

Désolé, je n'avais pas vu le 2e fichier. Les règles du jeu ont changé.

Bonjour,

@3GB

@xorsankukai

@Numéro 2

Merci à vous trois honnêtement cette entraide fait chaud au cœur surtout en ces moments pas toujours facile !!

@Optimix il y a une macro qui correspond à la description du titre, en effet la macro de @Numéro 2 ou de @xorsankukai dans les premiers messages répondent bien à ma problématique. Désolé d'avoir "changé" le sujet

Rechercher des sujets similaires à "suppression ligne fonction blanche colonne"