Cade VBA d'extraction avec 1 condition

thomasdu40 · 18 Août 2010

Bonjour,

Je m'adresse aux professionnels d'Excel pour ce petit souci.

J'ai le code suivant qui m'extrait d'un fichier les données présentes dans l'onglet "ConstatsISO" pour alimenter un deuxième fichier dans des cellules respectives. Jusque là tout fonctionne correctement.🙂

Sauf que dans le fichier où sont extraites les données présentes dans les cellules de la colonne B ce sont des valeurs égales soit à E, PA, Obs, PF, PP ou PS qui s'y trouvent et saisies par des opérateurs. Ces valeurs se greffent dans la colonne P du second fichier.

Code:

Range("P" & lig).Value = .Range("B" & k).Value

Je voudrai que la macro m'extrait ces valeurs SAUF les cellules contenant la valeur PF. Si la valeur de la cellule est égale à PF il ne fait pas d'extraction et passe à la ligne suivante. Je pense qu'il faut y mettre une condition mais comment ?😕

Merci. Ci-dessous code complet.

Code:

With Wb.Sheets("ConstatsISO")
        For k = 8 To .[A65536].End(3).Row
            If .Range("A" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("A" & k).Value
                Range("P" & lig).Value = .Range("B" & k).Value
                Range("H" & lig).Value = .Range("C" & k).Value
                Range("Q" & lig).Value = .Range("D" & k).Value
                Range("R" & lig).Value = .Range("E" & k).Value
            End If
        Next
    End With

Odesta · 18 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Bonjour

utiliser la fonction IIF(...)
Une solution :

Code:

Range("P" & lig).Value = IIF(.Range("B" & k).Value="PF";"";.Range("B" & k).Value))

Cordialement

Staple1600 · 18 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Bonjour à tous

Une petit coquille dans le code VBA d'Odesta (que je salue)
Il faut remplacer le ; par ,

Code:

Range("P" & lig).Value = IIF([B][COLOR=Red].[/COLOR][/B]Range("B" & k).Value="PF"[COLOR=DarkSlateBlue],[/COLOR]"",[B][COLOR=Red].[/COLOR][/B]Range("B" & k).Value)

EDITION: une variante avec l'emploi de Switch

Code:

Sub b_test()
Dim lig&
lig = 1
    Range("A" & lig) = _
        Switch([B1] <> "PF", [B1], [B1] = "PF", Empty)
End Sub

A adapter au besoin sans oublier le .
(comme dans le code d'Odesta)

thomasdu40 · 18 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Merci Odesta,

Il me met erreur de syntaxe.

Staple1600 · 18 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Re

Tu n'as pas lu mon message thomas 🙂

voir ci-dessous

thomasdu40 · 18 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Je confirme même en mettant des virgules il met tjrs Erreur de syntaxe

thomasdu40 · 18 Août 2010

Re : Cade VBA d'extraction avec 1 condition

OK ca y est c'est bon il y avait une parenthèse en trop.

Malheureusement il m'extrait quand même les valeurs présentes dans le fichier recherché et je ne veux pas.

Staple1600 · 18 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Re

Ah oui j'avais oublié de parler de la dernière parenthèse qui est en trop

Il faut donc l'effacer . Désolé 🙁

PS: Une question : ce fil est-il la suite de celui-ci ?

Si oui, il aurait été plus simple de continuer dans ce premier fil
car il y avait des pièces jointes dans icelui permettant de réaliser des tests.

Guest · 18 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Bonjour thomas,

Je m'adresse aux professionnels d'Excel pour ce petit souci.

comme je ne suis pas professionnel d'Excel, je vais seulement répondre à l'ami Staple.

Ah oui j'avais oublié de parler de la dernière parenthèse qui est en trop

Il faut donc l'effacer . Désolé

J'en suis sûr maintenant, tu manques de soleil. Faut descendre...(Private joke)😀

thomasdu40 · 18 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Oui c'est la suite et dsl j'ai pas vraiment eu le reflexe de le reprendre de crainte que le post ne vienne pas ce mettre en première ligne.

Pour mon souci je pense que le code suivant qui dit que si la cellule A8 est remplie on traite la demande il faudrait y rajouter aussi la condition que si les cellules de la colonne B ne sont pas égales à PF on traite aussi.

Code:

If .Range("A" & k) <> "" Then

Voici le code où j'ai intégré la formule d'Odesta

Code:

With Wb.Sheets("ConstatsISO")
        For k = 8 To .[A65536].End(3).Row
            If .Range("A" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("A" & k).Value
                Range("P" & lig).Value = IIf(.Range("B" & k).Value = "PF", "", .Range("B" & k).Value)
                Range("H" & lig).Value = .Range("C" & k).Value
                Range("Q" & lig).Value = .Range("D" & k).Value
                Range("R" & lig).Value = .Range("E" & k).Value
            End If
        Next
    End With

Guest · 18 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Re,

Je ne suis pas un professionnel excel, mais je te réponds quand-même.

Avec tout ce que tu as obtenu, tu n'a pas une petite idée de comment faire?

A+

skoobi · 18 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Bonjour thomasdu40,
Ges 🙂, JM 🙂,

n'apporte rien à la discussion:

Je ne suis pas un professionnel excel, mais je te réponds quand-même.

Bin c'est JM le pro alors!!! 😀😀😛

Staple1600 · 18 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Re, Hasco (Mes hommages et merci pour ton Lien supprimé relatif à XML, du bien bel ouvrage)

Bonsoir skoobi

Non je suis pas un pro
Sinon j'aurai des sousous pour m'acheter Excel 2010 version pro justement 😀

Je suis pas non plus la Zahia du VBA*, qui elle l'était professionnelle 😛

PS: *je m'attribue la paternité de ce possible pseudo pour XLD
et j'en espère des royalties en sourires s'il devait être utilisé un jour

thomasdu40 · 19 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Bonjour à vous tous,

Merci Bruno,

Voici ce que j'ai comme solution :

Code:

With Wb.Sheets("ConstatsISO")
        For k = 8 To .[A65536].End(3).Row
            If .Range("A" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                If .Range("B" & k).Value = "PF" Then GoTo saute
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("A" & k).Value
                Range("P" & lig).Value = .Range("B" & k).Value
                Range("H" & lig).Value = .Range("C" & k).Value
                Range("Q" & lig).Value = .Range("D" & k).Value
                Range("R" & lig).Value = .Range("E" & k).Value
saute:
            End If
        Next
        End With

La il ne me recopie pas la ligne si les cellules de la colonne B sont égales à "PF" MAIS si je rajoute ce GO TO SAUTE dans le deuxième code pour analyser le deuxième onglet du fichier recherché il me marque : Erreur de compilation : Déclaration existante dans la portée en cours

Code:

 With Wb.Sheets("ConstatsISO22000")
        For k = 8 To .[A65536].End(3).Row
            If .Range("A" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                If .Range("B" & k).Value = "PF" Then GoTo saute
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("A" & k).Value
                Range("P" & lig).Value = .Range("B" & k).Value
                Range("H" & lig).Value = .Range("C" & k).Value
                Range("Q" & lig).Value = .Range("D" & k).Value
                Range("R" & lig).Value = .Range("E" & k).Value
saute:
            End If
        Next
    End With

Si vous avez une idée.

youky(BJ) · 19 Août 2010

Re : Cade VBA d'extraction avec 1 condition

Bonjour à tous,
Thomas, tu peux rectifier comme ceci sur tes 2 codes

Bruno

Code:

 With Wb.Sheets("ConstatsISO22000")
        For k = 8 To .[A65536].End(3).Row
            If .Range("A" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
            [COLOR="Red"]  If .Range("B" & k).Value <> "PF" Then [/COLOR]
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("A" & k).Value
                Range("P" & lig).Value = .Range("B" & k).Value
                Range("H" & lig).Value = .Range("C" & k).Value
                Range("Q" & lig).Value = .Range("D" & k).Value
                Range("R" & lig).Value = .Range("E" & k).Value
             [COLOR="red"] End If[/COLOR]  
            End If
        Next
    End With

Cade VBA d'extraction avec 1 condition

thomasdu40

Guest

Odesta

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

thomasdu40

Guest

Staple1600

XLDnaute Barbatruc

thomasdu40

Guest

thomasdu40

Guest

Staple1600

XLDnaute Barbatruc

Guest

Guest

thomasdu40

Guest

Guest

Guest

skoobi

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

thomasdu40

Guest

youky(BJ)

XLDnaute Barbatruc

Discussions similaires

Cade VBA d'extraction avec 1 condition

thomasdu40

Guest

Odesta

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

thomasdu40

Guest

Staple1600

XLDnaute Barbatruc

thomasdu40

Guest

thomasdu40

Guest

Staple1600

XLDnaute Barbatruc

Guest

Guest

thomasdu40

Guest

Guest

Guest

skoobi

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

thomasdu40

Guest

youky(BJ)

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency