Mixer Select Case avec la boucle For... Next, possible?

Le 09/07/2020 à 15:45

Salutations tout le monde!

Voici le code que j'utilise actuellement :

Sub CopierAO()

    'On détermine le nom du fichier actuel
    Dim nomfichier As Variant
    nomfichier = ThisWorkbook.Name

    'On détermine la fonction d'ouverture d'un fichier
    Dim Fichier As String
    Fichier = Application.GetOpenFilename

    'Ouverture fenêtre de selection du fichier d'entrée
    Workbooks.Open Filename:=Fichier
    'supprime le chemin
    Fichier = Dir(Fichier)

    'Détermination du fournisseur à insérer
    nom = InputBox("Quel est le fournisseur (en majuscule) ?")

    'Copie données fichier d'entrée vers fichier de sortie en fonction du fournisseur indiqué et de sa position dans le fichier AO
Select Case nom
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(2, 2): x = 17
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(3, 2): x = 23
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(4, 2): x = 29
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(5, 2): x = 35
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(6, 2): x = 41
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(7, 2): x = 47
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(8, 2): x = 53
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(9, 2): x = 59
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(10, 2): x = 65
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(11, 2): x = 71
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(12, 2): x = 77
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(13, 2): x = 83
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(14, 2): x = 89
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(15, 2): x = 95
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(16, 2): x = 101
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(17, 2): x = 107
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(18, 2): x = 113
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(19, 2): x = 119
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(20, 2): x = 125
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(21, 2): x = 131
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(22, 2): x = 137
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(23, 2): x = 143
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(24, 2): x = 149
Case Else
    'Si le nom du fournisseur n'est pas reconnu, on affiche les messages suivants
    MsgBox "Le fournisseur n'existe pas ou est mal orthographié"
    ActiveWorkbook.Close Savechanges:=False
    End
End Select

'Si X, la position du fournisseur, est supérieur à 0, alors
If x > 0 Then
    'On copie les données du fichier source vers la cellule du fournisseur concerné
    Range("I4:L420").Copy Workbooks(nomfichier).Sheets("AO").Cells(4, x)
    'On remet X à 0 pour purger le système
    x = 0
End If

    'Fermeture du classeur
    ActiveWorkbook.Close Savechanges:=False

    'On remet les réglages par défaut
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

    'Confirmation de l'exportation
    MsgBox "exportation des données réussite"

End Sub

Avec cette macro, si on ajoute un nouveau fournisseur ou si on enlève un fournisseur de manière définitive, on est obligé de venir modifier la macro à chaque fois. Ce qui est problématique.

Du coup, j'aimerai pouvoir "automatisé" le bouzin, un peu de cette manière (je ne remets que la partie que je souhaite modifier). Je précise que le code ci-dessous ne marche pas et je comprends pourquoi il ne marche pas. Mais y-a-t-il une autre solution?

Sub CopierAO()

[...]

    'On récupère le nombre de fournisseurs
    Dim FRN As Long
    FRN = Workbooks(nomfichier).Sheets("Fournisseurs").Range("B1")

    'Copie données fichier d'entrée vers fichier de sortie en fonction du fournisseur indiqué et de sa position dans le fichier AO
Select Case nom
For i = 1 To FRN
Dim b As Long
b = 2
Dim c As Long
c = 17
Case Workbooks(nomfichier).Sheets("Fournisseurs").Cells(b, 2): x = c
b = b + 1
c = c + 6
Next
Case Else
    'Si le nom du fournisseur n'est pas reconnu, on affiche les messages suivants
    MsgBox "Le fournisseur n'existe pas ou est mal orthographié"
    ActiveWorkbook.Close Savechanges:=False
    End
End Select

[...]

End Sub

Vous remerciant par avance de votre temps et de vos réponses.

Le 09/07/2020 à 16:26

Bonjour,

En fait, ce que tu fais, c'est comme si tu voulais écrire ta macro avec toutes les données variables.

C'est inutile, oublie select il y a en effet plus simple.

compteur = 0
b = 2
c = 17
flag = False
For i = 1 To FRN
    If nom = Workbooks(nomfichier).Sheets("Fournisseurs").Cells(b + compteur, 2) Then
        x = c + compteur * 6
        flag = True
    End If
Next
If Not flag Then MsgBox "Le fournisseur n'existe pas ou est mal orthographié"

avec un fichier ce serait plus facile ...

Le 09/07/2020 à 23:16

Bonjour à tous,

perso je partirais plus sur une recherche avec .find, sans boucler.
Mais comme dit Steelson, pas de fichier, pas de chocolat...

eric

Le 10/07/2020 à 04:30

Absolument eriiic, ou une recherche par dichotomie !

Le 15/07/2020 à 15:06

Désolé pour le temps de réponse. Plein de taf et pas assez de temps. Vous connaissez.

Voici deux fichiers anonymisés:

- Trame pour nego macros anoymisée : c'est le fichier qui va regrouper tous les retours des fournisseurs.

- Trame AO anonymisée : c'est le fichier envoyé au fournisseur, sur lequel il met les infos avant de nous renvoyer le fichier.

Si vous avez des questions supplémentaires, j'ai plus de facilité maintenant.

Vous remerciant par avance de votre aide.

12trame-pour-nego-macros-anonymisee.xlsm (148.84 Ko)
10trame-ao-anonymisee.zip (17.75 Ko)
Le 15/07/2020 à 17:45

Bonjour,

Bon je n'ai pas bien compris le fonctionnement global de ton application. Je pense qu'il y aurait d'autres façons de faire pour regrouper les informations.

Néanmoins, d'un point de vue syntaxique, j'écrirais :

Sub CopierAO()

'On empêche le refresh de l'écran pour accélérer la macro
Application.ScreenUpdating = False
'On empêche le rafraichissement de la barre d'état
Application.DisplayStatusBar = False
'On désactive les évènements pour éviter l'apparition de fenêtre
Application.EnableEvents = False

    'On détermine le nom du fichier actuel
    Dim nomfichier As Variant
    nomfichier = ThisWorkbook.Name

    'On détermine la fonction d'ouverture d'un fichier
    Dim Fichier As String
    Fichier = Application.GetOpenFilename

    'Ouverture fenêtre de selection du fichier d'entrée
    Workbooks.Open Filename:=Fichier
    'supprime le chemin
    Fichier = Dir(Fichier)

    'Détermination du fournisseur à insérer
    nom = InputBox("Quel est le fournisseur (en majuscule) ?")

    'Détermine où seront copier les données fichier d'entrée vers fichier de sortie en fonction du fournisseur indiqué et de sa position dans le fichier AO
    Dim cel As Range
    Set cel = Workbooks(nomfichier).Sheets("Fournisseurs").Columns("B").Find(nom)
    If cel Is Nothing Then
        'Si le nom du fournisseur n'est pas reconnu, on affiche les messages suivants
        MsgBox "Le fournisseur n'existe pas ou est mal orthographié"
        ActiveWorkbook.Close Savechanges:=False
        Exit Sub
    Else
        X = cel.Offset(0, 1)
    End If

'Si X, la position du fournisseur, est supérieur à 0, alors
If X > 0 Then
    'On copie les données du fichier source vers la cellule du fournisseur concerné
    Range("I4:L420").Copy Workbooks(nomfichier).Sheets("AO").Cells(4, X)
    'On remet X à 0 pour purger le système
    X = 0
End If

    'Fermeture du classeur
    ActiveWorkbook.Close Savechanges:=False

    'On remet les réglages par défaut
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

    'Confirmation de l'exportation
    MsgBox "exportation des données réussite"

End Sub

avec en colonne C de ton onglet Fournisseurs les valeurs de X :

17
23
29
35
41

etc.

Le 16/07/2020 à 10:46

Merci Steelson, ça marche parfaitement!

Il y a très certainement des moyens de faire plus simple. Mais je n'y ai pas pensé.

L'objectif de ce fichier est de regrouper les réponses des fournisseurs lors d'un appel d'offre. Sachant qu'en moyenne, il y a 130 produits, à minima 24 fournisseurs et que tous ne répondent pas à l'ensemble des 130 produits.

Initialement, on faisait du copier/coller manuellement. Mais c'était pas le plus rapide.

Sachant que la finalité est de créer un TCD qui permette d'avoir les propositions des fournisseurs pour chaque référence. Mais cette partie, je ne l'ai pas mise dans le fichier transmis, car je n'ai pas de soucis sur ce point.

Encore merci.

Rechercher des sujets similaires à "mixer select case boucle next possible"