Comparer transfer-effacer ligne

Dernière réponse : 8 Juin 2010 18:33 dans Programmation

dianbobo

12 Mai 2010 16:49:14

Sub Bouton1()

Dim rngBF1 As Range, rngBF2 As Range

dim vLig as long

 
Application.ScreenUpdating = False

 
'définition de la plage sur la feuille synthèse (ici de A1 à la dernière cellule remplie) : 

Set rngBF1 = Sheets("synthèse").Range("A1:" & Sheets( _

             "synthèse").Cells(Rows.Count, 1).End(xlUp).Address)

 
'définition de la plage sur la feuille MC (ici de G1 à la dernière cellule remplie) : 

Set rngBF2 = Sheets("MC").Range("G1:" & Sheets( _

             "MC").Cells(Rows.Count, 7).End(xlUp).Address)

 
For Each cell In rngBF1

    If Not IsError(Application.Match(cell, rngBF2, 0)) Then

        vLig = Application.Match(cell, rngBF2, 0) 'vLig = n° de la ligne trouvée dans la feuille MC

        If Sheets("MC").Range("AA" & vLig) = "TF-Post" Then

            'on ne fait rien

        Else

            Sheets("synthèse").Rows(cell.Row).Delete

        End if

    Else

        Application.ScreenUpdating = True

        cell.Select

        msgbox "Cellule " & cell.Address & " sans correspondance dans MC", vbokonly + vbcritical, "Anomalie"

    End If

Next

 
Application.ScreenUpdating = True

End Sub

il fonctionne mais trop lent car il verifie si chaque cellule de la colonne A a bien un correspondant a la colonne G de la feuille "MC"

donc il y a une boite de dialogue qui s'affiche a chaque fois qu'il n'y pas de correspondance et moi je dois cliquer dessus pour pouvoir avancer
du coup s'il y a 10000 cellules a tester de sera donc penible ..!!

si quelqu'un peu bien me donner de l'aide sur ce code
merci

avant tout sachez que :

j'ai testé le code je croix qu'il est bon mais il y a un soucis par rapport a deux choses
premierement ma feuille synthese est un filtre que j'ai réalisé via un code
du coup dans ma feuille synthese il y a des lignes qui n'existent pas ma premiere cellule est donc A51 mais peu etre A30 car ça depend du fichier source qui n'a toujours pas le meme nombre de valeurs à trier.
donc ma premiere valeur et en A51 par exemple et la derniere
A200 par exemple mais il y a supression de certaines lignes entre A51 ET A200..
aussi dans la feuille "MC" c'est a partir de G2 que les nombres commencent

donc quand j'ai executé le code j'ai eu le message d'erreur ci-dessous DANS UNE BOITE DE DIALOGUE appelée "ANOMALIE"
" cellule $A$1 sans correspondance dans MC
lorsque je clic sur OK ça me fais passé a la cellule suivante .. et ainsi de suite .. jusqu'a ce que je parcours toute la colonne "A" mais si j'ai une colonne A a 1000 cellules ça devient penible
sinon j'ai supression des lignes ça signifie que le code m'efface bien ce que je veux ...

merci de votre aide POUR LE RENDRE PLUS EFFICACE :sol:

Autres pages sur : comparer transfer effacer ligne

| Etre averti des réponses
| Alerter

Répondre à dianbobo

Lassé par la pub ? Créez un compte

Meilleure solution

zeb

Expert Programmation

7 Juin 2010 15:59:44

Bon, alors il faut que tu comprennes ce que tu fais.
Le For Step -1 de la ligne 9, c'est très bien, c'est exactement ce qu'il faut faire.
Par contre, pourquoi le faire à la ligne 12 ???

Avec tes k et k_1, tu t'embrouilles peut-être. Et on avait des variables pour les feuilles. Où sont-elles passées ? Aide-moi à t'aider, ne me rebond pas un code 100% différents à chaque fois.

Bon, alors, je t'ai réécris tout ça. Tu observeras que je donne des noms cohérents à mes variables :

Dim numero   As Long
Dim ws_mc    As Worksheet
Dim ws_sy    As Worksheet
Dim i_mc     As Long
Dim i_sy     As Long
Dim nblig_mc As Long
Dim nblig_sy As Long
 
Set ws_mc = Worksheets("MC")
Set ws_sy = Worksheets("Synthèse")
 
nblig_mc = ws_mc.Cells(Rows.Count, 7).End(xlUp).Row
nblig_sy = ws_sy.Cells(Rows.Count, 1).End(xlUp).Row
 
For i_sy = nblig_sy To 1 Step -1
    If ws_sy.Cells(i_sy, 3).Text Like "*EMTN*" Or _
       ws_sy.Cells(i_sy, 3).Text Like "*Oblig*" Then
        numero = ws_sy.Cells(i_sy, 1).Value
        For i_mc = 1 To nblig_mc
            If numero = ws_mc.Cells(i_mc, 7).Value Then
                If ws_mc.Cells(i_mc, 27).Text <> "TF-Post" Then
                    MsgBox "Paré à supprimer la ligne " & i_sy & vbCrLf & vbCrLf & _
                           "Ligne de synthèse : " & i_sy & vbCrLf & _
                           "Code (3) : " & ws_sy.Cells(i_sy, 3).Text & vbCrLf & _
                           "Numéro : " & ws_sy.Cells(i_sy, 1).Value & vbCrLf & vbCrLf & _
                           "Ligne de MC : " & i_mc & vbCrLf & _
                           "Code (27) : " & ws_mc.Cells(i_mc, 27).Text & vbCrLf & _
                           "Numéro : " & ws_mc.Cells(i_mc, 7).Value, , _
                           "Suppression de la ligne " & i_sy
                    ws_sy.Rows(i_sy).Delete
                End If
                Exit For
            End If
        Next
    End If
Next

Alors, c'est pas plus clair comme ça ?
Pour info, c'est TON code, juste revu, avec des noms de variables un peu plus parlants.

Pour moi, ce code est correct. J'ai ajouté la boîte de dialogue pour que tu vois pourquoi ça ne fait pas ce que tu veux.

| Alerter

Répondre à zeb

zeb

Expert Programmation

14 Mai 2010 08:31:07

Salut,

Citation :

sinon j'ai supression des lignes ça signifie que le code m'efface bien ce que je veux ...

Ouh que c'est pas-bien ! A lire, au plus vite : Supprimer des lignes dans un tableau.

Je ne sais pas ce que tu dois faire en cas d'anomalie. Si c'est juste pour information, alors tu peux accumuler les adresses des cellules anormales dans une variables et ne l'afficher qu'à la fin, par exemple.
Après la ligne 26, il aurait fallu remettre le ScreenUpdating à Faux. Mais comme on va faire autrement.

Tu as un autre problème. Le filtre ne fait que cacher les lignes dont tu n'as pas besoin. Mais elles existent toujours. Et VB les voient ! Utilise leur propriétés Height

N'utilise pas des Sheets() mais des Worksheets(). C'est plus précis.
Utilise des variables pour désigner tes feuilles.

Pour désigner une seule cellule, n'utilise pas Range() mais Cells(). C'est moins de boulot pour XL.

| Alerter

Répondre à zeb

dianbobo

18 Mai 2010 12:15:24

bounjour
commet je fais pour utiliser les proprietes Height ?? :??:

| Alerter

Répondre à dianbobo

zeb

Expert Programmation

18 Mai 2010 13:32:54

Ben tu lis la propriétés Height de la cellule.
Si elle est égale à zéro, elle est filtrée (invisible) sinon, c'est qu'elle est visible :spamafote:

| Alerter

Répondre à zeb

dianbobo

4 Juin 2010 09:50:59

bonjour tout le monde
je vous explique ce que j'essai de faire dans ce code:
ma feuille active se nomme ("Synthèse") cette feuille synthese contient un tableau de la colonne A a la colonne I .La colonne A contient des nombres entiers
je veux donc rechercher chacun des numeros de la colonne A dans ma feuille nommé ("MC") a la colonne G une fois ce numero trouvé je reste dans ma feuil "MC" a la meme ligne je vais a la colonne AA regardé si j'ai le caractere "TF-Post" si j'ai le caractere "TF-Post" je conserve la ligne de la feuille "synthese " correspondante sinon je l'efface:
voici un exemple
supposons que j'ai dans ma feuille synthese A5=1022 alors je vais chercher ce numero a la colonne G dans ma feuille "MC"
supposons que je trouve ce numero a la ligne 100 de la colonne G donc
G100=1022 a partir de là je vais a la COLONNE AA toujours de ma feuille "MC" a la ligne 100
SI AA100="TF-Post" alors je conserve la ligne
5 de ma feuille synthese sinon je la suprime.

regarder mon code:

Sub Bouton1()

    Dim Lig As Long

        With Worksheets("Synthèse")

            While Cells(Lig, 1) <> ""

                If .Cells(Lig, 1) = Worksheets("MC").Cells(Lig, "G") Then

                    .Cells(Lig, "AA") = "TF-Post"

                    Lig = Lig + 1

                Else

                    Worksheets("Synthèse").Rows(Lig).Delete

                End If

            Wend

        End With

End Sub

mais j'ai une erreur ici:

Code VBScript :While Cells(Lig, 1) <> ""
(erreur definie par l'application ou par l'objet")
mais je n'arrive pas a la corriger

merci de votre aide

| Alerter

Répondre à dianbobo

zeb

Expert Programmation

4 Juin 2010 12:16:48

Salut Dianbobo,

Toujours les mêmes choses :
1°) Indente correctement ton code. Tiens c'est presque parfait cette fois-ci

2°) N'utilise pas While .. Wend mais Do While .. Loop

3°) Initialise tes variables

Je t'invite à éviter la syntaxe With. Utilise des variables à la place :

Dim Lig         As Long

Dim ws_synthese As Worksheet

Dim ws_mc       As Worksheet

 
Set ws_synthese = Worksheets("Synthèse" )

Set ws_mc = Worksheets("MC" )

 
Do While Cells(Lig, 1) <> ""

    If ws_synthese.Cells(Lig, 1) = ws_mc.Cells(Lig, "G" ) Then

        ws_synthese.Cells(Lig, "AA" ) = "TF-Post"

        Lig = Lig + 1

    Else

        ws_synthese.Rows(Lig).Delete

    End If

Loop

Maintenant que c'est plus clair, regarde bien la ligne 6. Deux erreurs s'y cachent.

| Alerter

Répondre à zeb

dianbobo

4 Juin 2010 13:30:14

d'abord apres lecture de ton code je pense qu'il ne fait pas ce que je veux a moins que je me trompe
voila :
la ligne 10 de ton code me semble incorrecte parceque la colonne AA en question est dans la feuille "MC" et non dans la feuille "synthese"
!! la ligne de ma feuille synthese est conservée lorsque je retrouve le numero en colonne G de "MC" d'ou:

If ws_synthese.Cells(Lig, 1) = ws_mc.Cells(Lig, "G" ) Then

une fois le numero trouvé je vais a la colonne AA de la feuille MC voir si sur cette meme ligne j'ai "TF-Post" sinon
je suprime la ligne de la feuille synthese donc a mon avi il y a une seconde condition:

if ws_mc.Cells(Lig, "AA" ) = "TF-Post" then

..
ce qui donne :

Dim Lig        As Long

Dim ws_synthese As Worksheet

Dim ws_mc      As Worksheet

Set ws_synthese = Worksheets("Synthèse" )

Set ws_mc = Worksheets("MC" )

Do While Cells(Lig, 1) <> ""

   If ws_synthese.Cells(Lig, 1) = ws_mc.Cells(Lig, "G" ) Then

        if ws_mc.Cells(Lig, "AA" ) = "TF-Post" then

        Lig = Lig + 1

    Else

        ws_synthese.Rows(Lig).Delete

    End If

end if

Loop

mais je n'arrive pas a voir les deux erreurs dont tu parle
j'ai essayé le code il ne tourne pas quelque chose ne va pas mais je vois pas :??:

| Alerter

Répondre à dianbobo

zeb

Expert Programmation

4 Juin 2010 13:48:26

Si tu vois une erreur dans mon code, c'est que c'est ton erreur.

En effet, ligne 6 de ton premier code, tu écrivais .Cell(..), ce qui se référait au With précédent. Cette syntaxe simplifie parfois le code, je trouve qu'elle le complique. Bref, écoute mes conseils, et ne l'utilise pas avant d'être très à l'aise en programmation VB (ce qui devrait arriver vite

).

Regarde mieux la ligne 6 de ton dernier code.
Et pose-toi des questions sur chaque mot :

Do While Cells(Lig, 1) <> ""

* Do C'est Zeb qui l'a dit, c'est bon,
* While C'est Zeb qui l'a dit, c'est bon,
* Cells Qu'est ce qu'il a dit le pengouin-à-pancarte ? A oui, de mettre le nom de la feuille avant !!!!!!
* (Lig, 1) Quelle est la valeur de Lig ? A ce propos, qu'est ce qu'il a dit le rougeot-à-ressort ? A oui, d'initialiser ses variables !!!!!!!
* <> "" Le pénible-de-service ne m'a-t-il pas déjà dit dans plusieurs autres topics de préciser Value ou Text ?

| Alerter

Répondre à zeb

dianbobo

4 Juin 2010 14:45:53

c'est vrai c'etait mon erreur a la base désolé
alors pour ce qui est ci dessous :

Dim Lig As Long

        Dim ws_synthese As Worksheet

        Dim ws_mc As Worksheet

 
        Set ws_synthese = Worksheets("Synthèse")

        Set ws_mc = Worksheets("MC")

                Lig = 0

                Lig = Lig + 6 ' en fait je commence a la ligne 6

            Do While ws_synthese.Cells(Lig, 1).Value <> ""

                    If ws_synthese.Cells(Lig, 1).value = ws_mc.Cells(Lig, "G").value Then

                        If ws_mc.Cells(Lig, "AA").Text = "TF-Post" Then

                        Lig = Lig + 1

                        Else

                        ws_synthese.Rows(Lig).Delete

                        End If

                    End If

            Loop

est ce correcte? :??:

| Alerter

Répondre à dianbobo

zeb

Expert Programmation

7 Juin 2010 09:02:13

Bon, ça commence à ressembler à quelque chose.
Mais tu ne peux pas parcourir les lignes d'un tableau et en supprimer quelques unes comme ça. J'explique pourquoi ici : http://www.presence-pc.com/forum/ppc/Programmation/tuto...

| Alerter

Répondre à zeb

dianbobo

7 Juin 2010 12:25:38

bonjour j'ai fait une lecture sur la supression des lignes en vba bon comme il y a une boucle for j'ai donc ecris le code de la façon suivante:

Dim k As Long

Dim k_1 As Long

Dim i As Long, j As Long

Dim numero As Long

      k = Worksheets("MC").Cells(Rows.Count, 7).End(xlUp).Row

    k_1 = Worksheets("Synthèse").Cells(Rows.Count, 1).End(xlUp).Row

 For i = 1 To k_1

    If Cells(i, 2).Value Like "*AFS*" Then

        numero = Cells(i, 1).Value

        For j = 2 To k

            If numero = Worksheets("MC").Cells(j, 7).Value Then

                If Worksheets("MC").Cells(j, 27).Text = "TF-Post" Then

                   i = i + 1

                Else

                Worksheets("Synthèse").Rows(i).Delete

                End If

                Exit For

            End If

        Next

 
    End If

Next

et puis j'ai fais la modification en partant de la derniere ligne :

Dim k As Long

Dim k_1 As Long

Dim i As Long, j As Long

Dim numero As Long

      k = Worksheets("MC").Cells(Rows.Count, 7).End(xlUp).Row

    k_1 = Worksheets("Synthèse").Cells(Rows.Count, 1).End(xlUp).Row

 For i = k_1 To 1 step -1

    If Cells(i, 2).Value Like "*AFS*" Then

        numero = Cells(i, 1).Value

        For j = k To 2 step -1

            If numero = Worksheets("MC").Cells(j, 7).Value Then

                If Worksheets("MC").Cells(j, 27).Text <> "TF-Post" Then

                   Worksheets("Synthèse").Rows(i).Delete

                Else

                  i=i-1

                End If

                Exit For

            End If

        Next

 
    End If

Next

mais, mais ce code me suprime toutes les ligne sauf une seule :??:

merci d'avance

| Alerter

Répondre à dianbobo

zeb

Expert Programmation

7 Juin 2010 12:37:41

Mais qu'est ce que tu fais ?
C'est le For de la ligne 7 qui gère le i.
Tu ne dois pas le faire toi-même, ligne 15.

Et t'es revenu à du code où tu ne précises pas les feuilles devant les Cells. Si tu n'écoutes pas ce que je dis, ben je ne vais plus rien dire. :fou:

| Alerter

Répondre à zeb

dianbobo

7 Juin 2010 13:17:24

c'est vrai que j'ai posté sans vraiment faire attention

:Et t'es revenu à du code où tu ne précises pas les feuilles devant les Cells

desolé
c'est mieux comme ça?

Dim k As Long

Dim k_1 As Long

Dim i As Long, j As Long

Dim numero As Long

      k = Worksheets("MC").Cells(Rows.Count, 7).End(xlUp).Row

    k_1 = Worksheets("Synthèse").Cells(Rows.Count, 1).End(xlUp).Row

 
 
    For i = k_1 To 1 step -1 

        If Worksheets("Synthèse").Cells(i, 3).Text Like "*EMTN*" Or Worksheets("Synthèse").Cells(i, 3).Text  Like "*Oblig*" Then

            numero = Worksheets("Synthèse").Cells(i, 1).Value

            For j = k To 2 step -1

                 If numero = Worksheets("MC").Cells(j, 7).Value Then

                    If Worksheets("MC").Cells(j, 27).Text <> "TF-Post" Then

                        Worksheets("Synthèse").Rows(i).Delete

                    Else

                    'on ne fait rien

                    End If

                Exit For

            End If

            Next

        End If

    Next

ça tourne mais il me reste aucune ligne sur la feuille :??:

je me suis dit que la supression de ligne se passe dans la feuille synthèse donc il suffit de decrementer la boucle

For i = k_1 To 1 step -1 ....

et de garder la seconde boucle incrementée

for j=2 to k......

mais j'ai toujours le meme problème.

| Alerter

Répondre à dianbobo

dianbobo

8 Juin 2010 07:07:02

Bonjour tout le monde ,bonjour Zeb
j'ai essayé le code c'est bien ce que j'ai ecris . mais il fait la chose suivante :
la boucle commence a la derniere ligne de la feuille synthese ,la boite de dialogue me montre a quelle ligne dans la feuille "MC" correspond le "numero" que j'ai definis dans le code puis à la colonne 27 ce que j'ai comme caractere "TF-Post" ou pas puis la ligne est suprimé et on passe a la ligne precedent.
toutes les lignes sont suprimées :whistle:

et pourtant j'ai cru ecrire une condition pour qu'une ligne soit suprimé ou pas :??:

If numero = ws_mc.Cells(i_mc, 7).Value Then

               If ws_mc.Cells(i_mc, 27).Text <> "TF-Post" Then...

mais dans mon code qu'il rencontre le caractere TF-Post ou pas il me suprime la ligne avant d'aller a la ligne precedente.

là je suis un peu perdu. :??:

merci d'avance

| Alerter

Répondre à dianbobo

zeb

Expert Programmation

8 Juin 2010 08:09:29

Salut,

Alors c'est qu'il n'y a pas écrit "TF-Post" dans ta cellule.

Utilise ce message à la ligne 22 pour t'en convaincre :

MsgBox "Code (27) : >>>>" & ws_mc.Cells(i_mc, 27).Text & "<<<<", , _

       "Suppression de la ligne " & i_sy

Forcément, si il y a des espaces, des lettres majuscules ou minuscules différentes, ça ne marchera pas.

| Alerter

Répondre à zeb

dianbobo

8 Juin 2010 08:34:18

voila j'ai mis le message aa la ligne 22 comme ceci:

Dim numero  As Long

Dim ws_mc    As Worksheet

Dim ws_sy    As Worksheet

Dim i_mc    As Long

Dim i_sy    As Long

Dim nblig_mc As Long

Dim nblig_sy As Long

 
Set ws_mc = Worksheets("MC")

Set ws_sy = Worksheets("Synthèse")

 
nblig_mc = ws_mc.Cells(Rows.Count, 7).End(xlUp).Row

nblig_sy = ws_sy.Cells(Rows.Count, 1).End(xlUp).Row

 
For i_sy = nblig_sy To 1 Step -1

    If ws_sy.Cells(i_sy, 3).Text Like "*EMTN*" Or _

      ws_sy.Cells(i_sy, 3).Text Like "*Oblig*" Then

        numero = ws_sy.Cells(i_sy, 1).Value

        For i_mc = 1 To nblig_mc

            If numero = ws_mc.Cells(i_mc, 7).Value Then

                If ws_mc.Cells(i_mc, 27).Text <> "TF-Post" Then

                MsgBox "Code (27) : >>>>" & ws_mc.Cells(i_mc, 27).Text & "<<<<", , _

                  "Suppression de la ligne " & i_sy

                          MsgBox "Paré à supprimer la ligne " & i_sy & vbCrLf & vbCrLf & _

                          "Ligne de synthèse : " & i_sy & vbCrLf & _

                          "Code (3) : " & ws_sy.Cells(i_sy, 3).Text & vbCrLf & _

                          "Numéro : " & ws_sy.Cells(i_sy, 1).Value & vbCrLf & vbCrLf & _

                          "Ligne de MC : " & i_mc & vbCrLf & _

                          "Code (27) : " & ws_mc.Cells(i_mc, 27).Text & vbCrLf & _

                          "Numéro : " & ws_mc.Cells(i_mc, 7).Value, , _

                          "Suppression de la ligne " & i_sy

                    ws_sy.Rows(i_sy).Delete

                End If

                Exit For

            End If

        Next

   End If

Next

et ça marche toujours ,j'ai encore regardé si dans ma cellule j'ai TF-post et bien oui!! mais toutes les lignes sont suprimées comme tout a l'heure. :??:

| Alerter

Répondre à dianbobo

dianbobo

8 Juin 2010 08:38:02

Zeb au lieu d'ecrire j'ai fait un copier coller du mot TF- Post de la feuille vers mon code et j'ai remarquer qu'il y avait un peu plus d'espace entre TF et Post
puis j'ai relancé le code . et ça marche bien :bounce:

vu que ça marche bien comment ne plus avoir a cliquer sur la boite de dialogue pour que le passage d'une ligne aune autre se face tout seul.

merci

| Alerter

Répondre à dianbobo

dianbobo

8 Juin 2010 08:41:52

comme ça non :??:

Dim numero  As Long

Dim ws_mc    As Worksheet

Dim ws_sy    As Worksheet

Dim i_mc    As Long

Dim i_sy    As Long

Dim nblig_mc As Long

Dim nblig_sy As Long

 
Set ws_mc = Worksheets("MC")

Set ws_sy = Worksheets("Synthèse")

 
nblig_mc = ws_mc.Cells(Rows.Count, 7).End(xlUp).Row

nblig_sy = ws_sy.Cells(Rows.Count, 1).End(xlUp).Row

 
For i_sy = nblig_sy To 1 Step -1

    If ws_sy.Cells(i_sy, 3).Text Like "*EMTN*" Or _

      ws_sy.Cells(i_sy, 3).Text Like "*Oblig*" Then

        numero = ws_sy.Cells(i_sy, 1).Value

        For i_mc = 1 To nblig_mc

            If numero = ws_mc.Cells(i_mc, 7).Value Then

                If ws_mc.Cells(i_mc, 27).Text <> "TF- Post" Then

 
 
                    ws_sy.Rows(i_sy).Delete

                End If

                Exit For

            End If

        Next

   End If

Next