Cade VBA d'extraction avec 1 condition

[thomasdu40]

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.

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.

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]

Re : Cade VBA d'extraction avec 1 condition

Bonjour

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

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

Cordialement

 

[Staple1600]

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 ,

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

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]

Re : Cade VBA d'extraction avec 1 condition

Merci Odesta,

Il me met erreur de syntaxe.

 

[Staple1600]

Re : Cade VBA d'extraction avec 1 condition

Re

Tu n'as pas lu mon message thomas

voir ci-dessous

 

[thomasdu40]

Re : Cade VBA d'extraction avec 1 condition

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

 

[thomasdu40]

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]

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]

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]

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.

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

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

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]

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]

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]

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]

Re : Cade VBA d'extraction avec 1 condition

Bonjour à vous tous,

Merci Bruno,

Voici ce que j'ai comme solution :

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

 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)]

Re : Cade VBA d'extraction avec 1 condition

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

Bruno

 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