Problème de boucle

Bonjour,

Je dispose de données organisées dans un tableau xls.

Chaque "fiche" tient en 2 colonnes et 30 lignes.

Toutes les fiches sont empilées dans les colonnes A-B

Comme mes fiches correspondent à 4 cas différents mais avec les mêmes données, j'ai créé 4 macros qui récupèrent ces données dans un autre tableau xls et qui permettent de mettre chaque fiche sur une seule ligne selon le cas.

La récupération des données est la même pour les 4 macros et les variables portent le même nom.

La seule différence est dans la mise à plat des données qui ne sont pas attribuées à la même colonne selon le cas.

La structure principale de la macro est basée sur un

Sub mise_a_plat ()
' déclaration des variables et initialisation du compteur
'
Do
'
'compteur de lignes
'
' repérage du cas initial
cas$ = ""
For i = rang + 1 To fin
If Left$(.Cells(i, 1).Value, 4) = "cas:" Then
cas$ = Mid$(.Cells(i, 1).Value, 6)
Exit For
Enf if
Next i
'
' RECUPERATION DES DONNEES
'
donnee1$ = ""
For i = rang + 1 To fin
If i < 100 and i > 1 Then
donnee1$ = i
Exit For
Enf if
Next i
'
' avec autant de For que de données à récupérer
'
' DISTRIBUTION DES DONNEES
With Sheets(feuilleDestination$)
.Cells(ligneActive, 1).Value = donnee1$
'
' avec autant de Cells que de données récupérées
'
.Cells(ligneActive + 1, 1).Activate
ligneActive = ActiveCell.Row
End With
 '
Set p = .FindNext(p)
Loop While Not (p Is Nothing) And (p.Row > firstAddress) And (p.Row < lastAddress)
'
End With
End

Comme la partie "récupération des données" est la même pour les 4 cas, je voudrais maintenant créer une distribution des données selon le cas initial.

Je ne sais pas où mettre le nouvel If :

If cas$ = "A" Then
' rangement1
Else 
   If cas$ = "B" Then
      'rangement2
Else
   If cas$ = "C" Then
      'rangement3
Else
   If cas$ = "D" Then
      'rangement4
End If

J'espère avoir été suffisamment clair.

Merci de votre aide.

Conil26

Bonsoir,

Essaye avec le code suivant :

Dim Donnée As String

Donnée = UCase(cas$)

Select Case Donnée

Case Is = "A"
' rangement1

Case Is = "B"
      'rangement2

Case Is = "C"
      'rangement3
Case Is = "D"
      'rangement4

End Select

Amicalement

Air2

Bonsoir,

Cette solution fonctionne à peu près dans le sens où elle écrit bien les données mais elle ne les dispose que selon le dernier cas.

Je ne me rappelle pas quelle est la fonction qui me rend la valeur d'une variable pour contrôler que je mets la bonne valeur en :

Case Is "A"

ça écrit systématiquement selon le dernier car je demande :

Case <> "A" Or "B" Or "C"

Je ne peux pas écrire

Case Is "D" 

car le contenu de D est variable d'une fiche à l'autre.

Mais j'ai un message d'erreur à la fin de chaque fiche :

"Erreur de la lecture de la fiche x ligne y"

Cdlt

Conil26

bonsoir,

Le select case sert a remplacer une serie de IF imbriqué, il te faut stoker le résultat dans une variable ou créer une fonction qui te permettra d'appliquer une action dans un select case que tu définiras par la suite..

Si tu peux joindre ton fichier cela permettra d'analyser ta problèmatique.

Cdt

Air2

Merci de cette proposition.

Classeur à 2 feuilles :

source : clos

destination : Destination.

bouton d'exécution de la macro en haut de la feuille Destination.

suivre les instructions.

La macro générale est dans le module1

les 4 autres sont dans les modules 2 à 5.

Merci

Conil26

Bonsoir,

Tu as effectivement un probleme de boucle, je te conseille de mettre en place plusieurs séquences.

Le moyen le plus rapide de voir ou se trouve le probleme et voir en direct le comportement de ton code est d'aller dans le classeur vba, et de cliquer sur la barre grisée a coté de la première ligne.

La ligne choisie sera alors surlignée, il te faudra relancer la macro qui s'arrêtera à ce point d'arrêt ainis marqué et ensuite presser la touche F8 (c'est ce que l'on peut appeler l'execution pas à pas du code ou de la macro) a chaque fois que tu presseras la dite touche regarde les évènements sur ta feuille excel.

On en reparlera, si tu trouves avant moi bravo (^_-)

Amitié

Air_2

Bonsoir,

Les premières conditions comme suit :

    If feuilleOrigine$ = "" Then On Error GoTo Erreur_Fatale ' ici A et B
    Worksheets(feuilleOrigine$).Activate

'    On Error GoTo 0 --- inutile ou placer la ligne ailleurs - A
'    On Error GoTo Erreur_Lecture --- inutile ou placer la ligne ailleurs - B

    Worksheets(feuilleDestination$).Activate
    ligneActive = ActiveCell.Row
    firstAddress = 1
    lastAddress = 1
    '
    texte_aide$ = "Entrer votre commande comme ci-dessous" & vbCr _
    & " * N (numéro simple) : transposer la fiche N" & vbCr _
    & " * N1-N2 (2 numéros séparés par un tiret) : de N1 à N2" & vbCr _
    & " * N- (numéro simple suivi d'un tiret) : à partir de N" & vbCr _
    & " * -N (tiret suivi d'un numéro) : jusqu'à N" & vbCr _
    & " * - (un tiret) : tout transposer" & vbCr _
    & vbCr _
    & "Note 1: le résultat sera transposé dans, ou à partir de, la ligne courante de la feuille Résultat" & vbCr
    Source$ = InputBox(texte_aide, "Transposition des fiches PaléoGW")
    If Source$ = "" Then
        N1$ = ""
        N2$ = ""
    Else
            If Trim$(Source$) <> "-" Then
                pos_tiret = InStr(1, Source$, "-")
                If pos_tiret > 0 Then
                    N1$ = Mid$(Source$, 1, pos_tiret - 1)
                    N2$ = Mid$(Source$, pos_tiret + 1)
                    If N2$ = "" Then lastAddress = 65536
                Else
                    N1$ = Source$

                End If
            End If
        premiere$ = "Fiche N° " & N1$
        derniere$ = "Fiche N° " & N2$
    End If

Et correction :

Case Is <> "N", Is <> "M", Is <> "D"
        'Mise en page "V"

Cela fonctionne malgrés mon petit soucis avec les *.xlm*

Amitié

Air2

Bonsoir,

C'est mieux. Cette modification supprime les messages d'erreur en fin de chaque fiche.

Mais persiste à faire les exports systématiquement au format D.

On progresse ;o)

Conil26

Bonsoir,

Super,

Peux-tu convertir ton fichier en *.xls* car j ai un petit soucis avec les *.xlm* s'il te plait ?

D'avance merci

Air_2

Trouvé !

Il fallait écrire :

Case Is "N "

Case is "M "

Case Is "D "

Case Is <> "N ", Is <> "M ", Is <> "D "

avec un espace à droite. ;o)

J'ai déplacé le

On Error GoTo

après les

MsgBox

Export réussi.

Au lieu de faire 4 passages et 4 tris sur 1 même fichier, j'obtiens 1 seul fichier entièrement exploitable.

Grand Merci

conil26