For Next & If

Le 13/02/2015 à 13:07

Bonjour,

Je suis en train d'adapter un fichier exercice de Gaëtan Mourmant, je fait donc un fichier fournisseurs / factures.

A chaque entrée d'une nouvelle facture, l'utilisateur peut choisir un fournisseur existant ou en créer un nouveau.

Si le fournisseur est nouveau, je l'inscrit dans la base "Fournisseurs" et rentre la facture dans la base "BD_Fact"

Si le fournisseur est déjà connu je rentre seulement la facture dans la base "BD_Fact"

En fait je n'arrive pas à utiliser la boucle For avec "Each cell In Range" et la condition if..

Four_nom : liste dynamique des fournisseurs

Consult_fact : champ d'entrée de fournisseur

BD_Fact : feuille des factures

Fournisseurs : feuille des fournisseurs

Merci de votre aide.

Sub Add_four()
'
'

For Each cell In Range("Four_nom")
If cell.Value = [Consult_fact] Then

'ajout de la facture seule
    Sheets("BD_Fact").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Range("A2").Select
    Sheets("Ajout").Select
    Range("2:2").Select
    Selection.Copy
    Sheets("BD_Fact").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Ajout").Select
    Range("F10,F17,F18").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("F10").Select
Next
Exit Sub

Else

'ajout du nouveau fournisseur a la base
    Sheets("Fournisseurs").Select
    Rows("2:2").Insert Shift:=xlDown
    [A2] = [Consult_fact]
    Range("A2:A65536").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Sheets("Consultation").Select

'ajout de la facture seule
    Sheets("BD_Fact").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Range("A2").Select
    Sheets("Ajout").Select
    Range("2:2").Select
    Selection.Copy
    Sheets("BD_Fact").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Ajout").Select
    Range("F10,F17,F18").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("F10").Select

End Sub
Le 13/02/2015 à 14:13

Bonjour et bienvenue sur le forum

Il serait plus facile de t'aider si tu joignais ton fichier...

Bye !

Le 13/02/2015 à 14:19

Je pensais que le code suffirait..

Fichier joint, merci.

12outil-compta.xlsm (195.46 Ko)
Le 13/02/2015 à 16:07

Tu écris :

je n'arrive pas à utiliser la boucle For avec "Each cell In Range" et la condition if..

Pourtant dans le fichier que tu as joint, j’en ai trouvé une dans le module 5 ( ajout_client) où tu sembles avoir maitrisé la technique.

En revanche, dans cette macro, un peu plus loin j’ai détecté une erreur et une maladresse :

    Range("A2:A65536").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

Tu sélectionnes la première colonne (sauf A1) sur laquelle tu fais un tri à l’instruction suivante.

Ce tri ne portera donc que sur A1 et pas sur l’ensemble du tableau.

Tu aurais intérêt à

• Condenser les 2 instructions

• limiter ta sélection à la dernière ligne du tableau

• mais surtout à inclure toutes ses colonnes, faute de quoi ton tableau se détraque complètement

Ce qui pourrait donner :

    Range("A2:H" & Range("A" & Rows.Count).End(xlUp).Row).Sort _
            Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal

OK ?

Mais si vraiment tu as un problème de boucle, explique moi ce que tu veux qu’une boucle te fasse…

Bye !

Le 14/02/2015 à 10:07

Meric Gmb,

Je regarde et potasse tout cela et te tiens au jus..

Le 16/02/2015 à 09:49

gmb,

Merci de coup de main et de l'erreur que je n'avais pas vu.

Je commence en vba, sans formation, ni aide.

Je suis en train d'adapter un fichier exercice (2006 !) de Gaëtan Mourmant.

Je ne sais pas faire de boucle, elle était déjà dans le fichier (module 5).

Dans le fichier que tu as, l'utilisateur peut rentrer une nouvelle facture (feuille ajout).

On vérifie alors que le fournisseur inscrit dans le champ est existant ou non,

intervention d'une boite de dialogue "voulez vous ajouter un nouveau nom".

Ca c'est bon, par contre...

Quand l'utilisateur ajoute la nouvelle facture via le bouton. On doit faire deux choses :

Fournisseur nouveau : l'inscrire dans la base "Fournisseurs" et rentrer la facture dans la base "BD_Fact"

Fournisseur déjà connu : rentrer seulement la facture dans la base "BD_Fact"

Et c'est là que je ne sais pas faire, vérifier les deux conditions et choisir la bonne,

en fonction de l'existence ou non du fournisseur.

Merci du suivi.

Le 18/02/2015 à 11:12

yo

Bon j'y suis quand même arrivé.

Explications :

  • On enregistre une facture en la notant dans une feuille,
    si le fournisseur (Valeur_C) de la facture existe, on enregistre simplement la facture.
    sinon on enregistre le nouveau fournisseur & la facture.
    J'ai utiliser une boucle if et la fonction find, plutôt que la boucle for..

Questions :

  • Je n'arrive pas à utiliser le nom de cellule "Add_four", plutôt que la position cellule : Sheets("Ajout").Range("G10").
    Est-ce possible d'utiliser le nom de cellule "Add_four" ?
    Une fois sur deux, le tri des listes (Bd_Four & BD_Fact) après ajout ne fonctionne pas, pourquoi ?
    Est-ce possible de réduire la taille / et ou améliorer le code VBA ?
Fichier joint

Merci bcp de votre aide.

Option Explicit

Sub Cherche_encore()
'déclaration des variables
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_C As String, Nom_t As String

    'on cherche la valeur de G10, feuille Ajout
    Valeur_C = (Sheets("Ajout").Range("G10"))

    'dans la feuille Fournisseurs, colonne 2
Set PlageDeRecherche = Sheets("Fournisseurs").Columns(2)

    'find, on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_C, LookAt:=xlWhole)

If Trouve Is Nothing Then
    'traitement au cas où la valeur n'est pas trouvée, donc nouveau fournisseur
    'copie de la ligne dans la feuille fournisseurs
    Sheets("Fournisseurs").Select
    Range("2:2").Select
    Selection.Insert Shift:=xlDown
    Range("a2").Select
    Sheets("Ajout").Select
    Range("B2:I2").Select
    Selection.Copy
    Sheets("Fournisseurs").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'tri liste des fournisseurs
    Range("A2:H" & Range("A" & Rows.Count).End(xlUp).Row).Sort _
            Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal

    'et copie de la ligne dans la feuille facture
    Sheets("BD_Fact").Select
    Range("2:2").Select
    Selection.Insert Shift:=xlDown
    Range("A2").Select
    Sheets("Ajout").Select
    Range("A2,B2,J2:M2").Select
    Selection.Copy
    Sheets("BD_Fact").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'tri de la liste des factures
    Range("A2:F" & Range("A" & Rows.Count).End(xlUp).Row).Sort _
            Key1:=Range("B2"), key2:=Range("c2"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal

    'vidage du formulaire
    Sheets("Ajout").Select
    Range("G10,G17,G18").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("G10").Select

Else
    'traitement au cas où la valeur est trouvée
    'copie de la ligne dans la feuille facture

    Sheets("BD_Fact").Select
    Range("2:2").Select
    Selection.Insert Shift:=xlDown
    Range("A2").Select
    Sheets("Ajout").Select
    Range("A2,B2,J2:M2").Select
    Selection.Copy
    Sheets("BD_Fact").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'tri de la liste des factures
    Range("A2:F" & Range("A" & Rows.Count).End(xlUp).Row).Sort _
            Key1:=Range("B2"), key2:=Range("c2"), Order1:=xlAscending, Order2:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal

    'vidage du formulaire
    Sheets("Ajout").Select
    Range("G10,G17,G18").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("G10").Select

End If

'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
End Sub
21outil-compta.xlsm (230.15 Ko)
Le 18/02/2015 à 14:20

Bonjour

Benz_13 a écrit :

Je n'arrive pas à utiliser le nom de cellule "Add_four", plutôt que la position cellule : Sheets("Ajout").Range("G10").

Déjà, il y a un couple de parenthèses inutile dans ton instruction.

Au lieu de

Valeur_C = (Sheets("Ajout").Range("G10"))

Ecris plus simplement :

Valeur_C = Sheets("Ajout").Range("G10")

Et si la cellule G10 est nommée ‘’Add_four’’, tu peux remplacer par :

Valeur_C = Sheets("Ajout").Range("Add_four")

J’ai essayé sur ton fichier : ça marche.

Une fois sur deux, le tri des listes (Bd_Four & BD_Fact) après ajout ne fonctionne pas, pourquoi ?

En début de ta macro ‘’Cherche_encore()’’ , tu sélectionnes une plage que tu copies.

Puis tu la colles sur une autre feuille :

…
Selection.Copy
Sheets("Fournisseurs").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Mais tu ne définies pas l’endroit où tu vas copier : ce sera à ‘’sélection’’. Donc à la cellule active de la feuille, ou à la plage qui y est sélectionnée si, par chance, elle a la même taille que la plage copiée. Sinon --> Bug !

Il ne faut donc pas s’étonner si le tri qui suit le ‘’collage spécial’’ ne fonctionne pas correctement.

Est-ce possible de réduire la taille / et ou améliorer le code VBA ?

Pour améliorer la rapidité d’exécution tu aurais intérêt à supprimer autant que possible les instructions qui finissent pa ‘’.select’’en les condensant avec l’instruction suivante.

Exemple. Tu as :

Sheets("Fournisseurs").Select
Range("2:2").Select
Selection.Insert Shift:=xlDown

Que tu pourrais remplacer par :

Sheets("Fournisseurs"). Range("2:2"). Insert Shift:=xlDown

OK ?

Bye !

Le 19/02/2015 à 08:39

Gmb,

Merci de ton soutien, j'ai pu faire les modifications

Ci-dessous le code nettoyé, je le met à dispo.

J'ai trouvé aussi une (seule) ligne de code VBA pour trier une liste, qui à l'air de marcher.

Sur le site que je recommande chaudement de http://boisgontierjacques.free.fr

Merci à tous.

Option Explicit

Sub Cherche_encore()
'déclaration des variables
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_C As String, Nom_t As String

    'on cherche la valeur de G10, feuille Ajout
    Valeur_C = Sheets("Ajout").Range("Add_four")

    'dans la feuille Fournisseurs, colonne 2
Set PlageDeRecherche = Sheets("Fournisseurs").Columns(2)

    'find, on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_C, LookAt:=xlWhole)

If Trouve Is Nothing Then
    'traitement au cas où la valeur n'est pas trouvée, donc nouveau fournisseur
    'copie de la ligne dans la feuille fournisseurs
    Sheets("Fournisseurs").Range("2:2").Insert Shift:=xlDown
    Sheets("Ajout").Range("B2:I2").Copy
    Sheets("Fournisseurs").Range("a2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'tri liste des fournisseurs
   Sheets("Fournisseurs").[A1].Sort key1:=Sheets("Fournisseurs").[B2], Order1:=xlAscending, Header:=xlGuess

    'et copie de la ligne dans la feuille facture
    Sheets("BD_Fact").Range("2:2").Insert Shift:=xlDown
    Sheets("Ajout").Range("A2,B2,J2:M2").Copy
    Sheets("BD_Fact").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'tri de la liste des factures
   Sheets("BD_Fact").[A1].Sort key1:=Sheets("BD_Fact").[B2], key1:=Sheets("BD_Fact").[C2], Order1:=xlAscending, Header:=xlGuess

    'vidage du formulaire
    Sheets("Ajout").Range("G10").ClearContents
    Range("G10").Select

Else
    'traitement au cas où la valeur est trouvée
    'copie de la ligne dans la feuille facture
    Sheets("BD_Fact").Range("2:2").Insert Shift:=xlDown
    Sheets("Ajout").Range("A2,B2,J2:M2").Copy
    Sheets("BD_Fact").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'tri de la liste des factures
   Sheets("BD_Fact").[A1].Sort key1:=Sheets("BD_Fact").[B2], key2:=Sheets("BD_Fact").[C2], Order1:=xlAscending, Header:=xlGuess

    'vidage du formulaire
    Sheets("Ajout").Range("G10").ClearContents
    Range("G10").Select

End If

'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
End Sub
Rechercher des sujets similaires à "next"