Macro sub VBA [Résolu]

Signaler
Messages postés
11
Date d'inscription
mercredi 9 avril 2008
Statut
Membre
Dernière intervention
11 avril 2008
-
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
-
Bonjour a tous!!
Je suis nouveau sur le site et ce serait vraiment super si qqun pouvait m'aider :)
Je dispose d'un tableau excel très mal fait...et j'ai plusieurs choses à faire dessus
Tout d'abord, je dois selectionner dans la première colonne l'ensemble des cellules ayant le format *00000 (une etoile suivie de 5chiffres) ou le format 000000 (6 chiffres) puis copier cette cellule ainsi que la cellule juste en dessous (contenant des lettres et parfois des chiffres) dans une nouvelle feuille excel ou nouveau fichier excel appelé BLABLA pour l'occasion, et cela sur une meme ligne mais 2 colonnes distinctes en supprimant les espaces entre :)


c'est à dire:
(Feuille excel 1)
(Colonne1)
*00000
text1
<vide>
<vide>
<vide>
*00008
text2
<vide>
<vide>
<vide>
000245
text3


 


                                 (Feuille excel 2)     (Colonne1)  (Colonne2)
Devient----------------------------->     *00000          text1
                                                              *00008          text2
                                                              *000245        text3




Après ça, il faut reprendre le nombre qui se situe sur la meme ligne que la cellule *00000 ou 000000 mais dans la colonne 3 (la colonne "C"), le copier et le coller dans la colonne 9 de la feuille 2 (colonne "I"). Le problème est qu'encore une fois, il s'agit un nombre précédé d'une étoile et 4 espaces (du style *    245) et qu'il ne faut reprendre que le nombre (bref supprimer l'étoile)
Illustration:


(Feuille excel 1)
(Colonne1) (Colonne 2) (Colonne3)
*00000                           *    665
text1
<vide>
<vide>
<vide>
*00008                            *    5488
text2
<vide>
<vide>
<vide>
000245                            *    448
text3


 


                                 (Feuille excel 2)     (Colonne1)  (Colonne2) (...) (Colonne 9)
Devient----------------------------->     *00000          text1                665
                                                              *00008          text2                5488
                                                              *000245        text3                 448
 


c'est pas fini lol ... mais si quelqu'un pouvait déja m'aider pour ca ce serait super!!!
merci!

20 réponses

Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
...

ok compris. Donc 2 petite modifs :

Option Explicit
Sub ParcoursFeuille()
    Dim i As long, DernierValeur As Long
    With Worksheets("Feuil1")
        On Local error resume Next
        DernierValeur = .Range("A:A").Find("*", [A1], , , xlByRows, xlPrevious).Row 'Attention le point devant le range est ici OBLIGATOIRE et pour la suite c'est pareille donc attention au point
        If Err <> 0 then 'Cela veut dire qu'il n'y a rien en colonne A donc on arrete tout
            Err.Clear
            Exit Sub
        End If
        For i = 1 to DernierValeur
            If  .Cells(i,1) <> "" Then
                Worksheets("Feuil2").Cells(i, 1).Value = .Cells(i,1).Value
                Worksheets("Feuil2").Cells(i, 2).Value = .Cells(i + 1,1).Value
                On Local error resume Next
                Worksheets("Feuil2").Cells(i, 9).Value = CDec(Replace(.Cells(i, 3).Value, "*", ""))
                i = i + 2
            Else
               i = i + 1
            End If
        Next i
    End With
End Sub

A+
Messages postés
11
Date d'inscription
mercredi 9 avril 2008
Statut
Membre
Dernière intervention
11 avril 2008

oulala je remarque que ma mise en page des colonnes a été estropiée dans le message...
Voici la derniere illustration,un peu plus au clair:

            (Feuille excel 2)     (Colonne1)  (Colonne2) (...) (Colonne9)
Devient--------------->     *00000          text1                    665
                                         *00008          text2                    5488
                                         *000245        text3                     448

thx!
Messages postés
27
Date d'inscription
lundi 18 février 2008
Statut
Membre
Dernière intervention
29 avril 2008

Bonjour,

Voici ce que je te propose :

Sub ParcoursFeuille()


Feuil1.Select


i = 1
j = 1


While Cells(i, 1) <> "FIN"
    Feuil1.Select
    If Cells(i, 1).Value Like "*[0-9][0-9][0-9][0-9][0-9]" Or Cells(i, 1).Value Like "[0-9][0-9][0-9][0-9][0-9][0-9]" Then
        Variable1 = Cells(i, 1).Value
        Variable2 = Cells(i + 1, 1).Value
        Variable3 = Cells(i, 3).Value
        'MsgBox (Cells(i, 1).Value)
        'MsgBox (Cells(i + 1, 1).Value)
        'MsgBox (Cells(i, 3).Value)


        Feuil2.Select
        Cells(j, 1) = Variable1
        Cells(j, 2) = Variable2
        Cells(j, 9) = Variable3
        j = j + 1
    End If
   
    i = i + 1
Wend


 


End Sub

Copie cette fonction dans un module VBA,


Ajoute le mot FIN dans la première colonne de ta première page à la suite de tes données.


Dis moi ensuite si jamais il y a un problème.
Messages postés
11
Date d'inscription
mercredi 9 avril 2008
Statut
Membre
Dernière intervention
11 avril 2008

Pour l'instant, j'ai le message "run-time error '424'"
Sinon merci pour la fonction "like (format cellule)", elle ne faisait pas partie de mes faibles connaissances! Je dois la réutiliser pour faire le meme genre de macro par apres mais avec des dates, je suppose que la formule sera:

If Cells(i, 3).Value Like "[0-9][0-9]/[0-9][0-9]/03" Then ... //copier valeur de la somme des cellules de la Feuil1 (i,4) + (i,5) + (i,6) + (i,7) + (i,8) + (i,9) dans la cellule (j,4) de la Feuil2//
elseif Cells(i, 3).Value Like "[0-9][0-9]/[0-9][0-9]/04" Then...//copier valeur de la somme des cellules de la Feuil1 (i,4) + (i,5) + (i,6) + (i,7) + (i,8) + (i,9) dans la cellule (j,5) de la Feuil2//
elseif Cells(i, 3).Value Like "[0-9][0-9]/[0-9][0-9]/05" Then...//copier valeur de la somme des cellules de la Feuil1 (i,4) + (i,5) + (i,6) + (i,7) + (i,8) + (i,9) dans la cellule (j,6) de la Feuil2//
elseif Cells(i, 3).Value Like "[0-9][0-9]/[0-9][0-9]/06" Then...//copier valeur de la somme des cellules de la Feuil1 (i,4) + (i,5) + (i,6) + (i,7) + (i,8) + (i,9) dans la cellule (j,7) de la Feuil2//
elseif Cells(i, 3).Value Like "[0-9][0-9]/[0-9][0-9]/07" Then...//copier valeur de la somme des cellules de la Feuil1 (i,4) + (i,5) + (i,6) + (i,7) + (i,8) + (i,9) dans la cellule (j,8) de la Feuil2//
elseif Cells(i, 3).Value Like "[0-9][0-9]/[0-9][0-9]/08" Then...//copier valeur de la somme des cellules de la Feuil1 (i,4) + (i,5) + (i,6) + (i,7) + (i,8) + (i,9) dans la cellule (j,9) de la Feuil2//
Endif

thx!
Messages postés
11
Date d'inscription
mercredi 9 avril 2008
Statut
Membre
Dernière intervention
11 avril 2008

Ha oui, j'ai décalé les colonnes d'un rang :/... en réalité, toutes les cellules (j, x) devraient être (j, x-1) dans la macro suivante

Sinon, j'ai bien adapté les paramètres de la macro que tu m'a proposé à mes paramètres, j'ai bien rajouté FIN à la suite des données de la 1° colonne, mais je retombe toujours sur le même run-time error
Tu aurais une idée d'ou ca peut provenir?
Messages postés
27
Date d'inscription
lundi 18 février 2008
Statut
Membre
Dernière intervention
29 avril 2008

Re,
Quelle ligne du code est surlignée quand tu fais débogage?
Messages postés
11
Date d'inscription
mercredi 9 avril 2008
Statut
Membre
Dernière intervention
11 avril 2008

Re Re
Aucune ligne n'est surlignée, c'est ca le problème.
:(
Messages postés
27
Date d'inscription
lundi 18 février 2008
Statut
Membre
Dernière intervention
29 avril 2008

Si tu exécutes ça est ce que ça fonctionne?

Sub ParcoursFeuille()


Feuil1.Select


i = 1
j = 1


While Cells(i, 1) <> "FIN"
    Feuil1.Select


   
    i = i + 1
Wend
Messages postés
27
Date d'inscription
lundi 18 février 2008
Statut
Membre
Dernière intervention
29 avril 2008

Excuse moi j'ai oublié le End Sub à la fin
Messages postés
11
Date d'inscription
mercredi 9 avril 2008
Statut
Membre
Dernière intervention
11 avril 2008

Ca me renvoit le même message d'erreur
Messages postés
27
Date d'inscription
lundi 18 février 2008
Statut
Membre
Dernière intervention
29 avril 2008

Comment se nomme ta première Feuille?
Je te conseille d'ouvrir Excel avec une page vierge, d'y copier tes données sur la 1ere page et de retenter le code.
Messages postés
11
Date d'inscription
mercredi 9 avril 2008
Statut
Membre
Dernière intervention
11 avril 2008

Merci quand même pour ton aide :) je vais continuer en ce sens, je pense qu'il n'y a pas grand chose à changer.
Si quelqu'un d'autre a une idée, je ne serais pas contre :)

thxx!
Messages postés
11
Date d'inscription
mercredi 9 avril 2008
Statut
Membre
Dernière intervention
11 avril 2008

[Je viens de voir le message en page 2]
Ma premiere feuille se nomme "Feuil1" et la 2° "Feuil2" comme prévu par tes paramètres. Je vais quand même essayer de faire ce que tu as dit
Messages postés
11
Date d'inscription
mercredi 9 avril 2008
Statut
Membre
Dernière intervention
11 avril 2008

Voilà, le problème reste identique.
Merci quand même Firelion :)
Je vais continuer a chercher, je finirai bien par trouver un jour lol
a++
Messages postés
27
Date d'inscription
lundi 18 février 2008
Statut
Membre
Dernière intervention
29 avril 2008

Ok, désolé de ne pas pouvoir aller plus loin dans cet exemple mais chez moi ça fonctionne bien. Essaye d'exécuter les instructions une par une peut être.
Je suis sûr Access 2003 mais je pense que les insctructions que j'ai utilisé sont basiques.


A+
Messages postés
27
Date d'inscription
lundi 18 février 2008
Statut
Membre
Dernière intervention
29 avril 2008

Un dernier truc à te proposer :

Sub ParcoursFeuille()


Worksheets("Feuil1").Select


i = 1
j = 1


While Cells(i, 1) <> "FIN"
    Worksheets("Feuil1").Select
    If Worksheets("Feuil1").Cells(i, 1).Value Like "*[0-9][0-9][0-9][0-9][0-9]" Or Worksheets("Feuil1").Cells(i, 1).Value Like "[0-9][0-9][0-9][0-9][0-9][0-9]" Then
        Variable1 = Worksheets("Feuil1").Cells(i, 1).Value
        Variable2 = Worksheets("Feuil1").Cells(i + 1, 1).Value
        Variable3 = Worksheets("Feuil1").Cells(i, 3).Value
        'MsgBox (Cells(i, 1).Value)
        'MsgBox (Cells(i + 1, 1).Value)
        'MsgBox (Cells(i, 3).Value)


        Worksheets("Feuil2").Select
        Worksheets("Feuil2").Cells(j, 1) = Variable1
        Worksheets("Feuil2").Cells(j, 2) = Variable2
        Worksheets("Feuil2").Cells(j, 9) = Variable3
        j = j + 1
    End If


    i = i + 1
Wend


 


End Sub
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
Salut,

beaucoup de remarque a faire surtout a Firelion.

1/ les variables doivent etre declarées et pour etre sur de les avoir correctement declarées on ecrit : Option Explicit
sur la premiere ligne du module
2/ pas besoin de selectioner les feuilles ou cellules ou plage de cellules il suffit de les specifier cela accelere le code
3/ pas besoin de passer par une variable pour attribuer la valeur d'une cellule a une autre cellule
4/ Quand on atribue ou recupere la valeur d'une cellule on le precise par .Value ou .Value2 ou .Text
5/ une boucle While Wend est une vielle methode, il est aujourd'hui preferable d'utiliser les boucles Do Loop avec les option While ou Untile.
6/ eviter ce type de boucle car on peut facilement ce retrouvé coincé a cause d'une boucle sans fin surtout quand la valeur de reference ce trouve dans une cellule qui peut avoir ete modifié par erreur, par ignorance ou autre.

C'est bien de vouloir aider mais attention  voila ceci etant dit.

Option Explicit
Sub ParcoursFeuille()
    Dim i As long, DernierValeur As Long
    With Worksheets("Feuil1")
        On Local error resume Next
        DernierValeur = .Range("A:A").Find("*", [A1], , , xlByRows, xlPrevious).Row 'Attention le point devant le range est ici OBLIGATOIRE et pour la suite c'est pareille donc attention au point
        If Err <> 0 then 'Cela veut dire qu'il n'y a rien en colonne A donc on arrete tout
            Err.Clear
            Exit Sub
        End If
        For i = 1 to DernierValeur
            If  .Cells(i,1) <> "" And InStr(1, Cells(i, 1).Value, "*", 1) = 1 Then
                Worksheets("Feuil2").Cells(i, 1).Value = .Cells(i,1).Value
                Worksheets("Feuil2").Cells(i, 2).Value = .Cells(i + 1,1).Value
                On Local error resume Next
                Worksheets("Feuil2").Cells(i, 9).Value = CLng(Replace(.Cells(i, 3).Value, "*", ""))
                i = i + 2
            Else
               i = i + 1
            End If
        Next i
    End With
End Sub

Vala, ce code considere que la structure de la feuille1 est exactement comme tu l'as decrite c'est a dire que la premiere ligne de la premiere colonne contient *00000

A+
Messages postés
27
Date d'inscription
lundi 18 février 2008
Statut
Membre
Dernière intervention
29 avril 2008

Bonjour bigfish et merci pour ces remarques,


Il me semble que la demande azgOrth était légèrement différente de ce que tu proposes. Ton code semble beaucoup mieux structuré syntaxiquement que le mien.
Ce que j'ai compris de l'énnoncé :
Le parcours de la 1ère colonne de la 1ère feuille doit permettre d'identifier chacune des cellules ayant le format d'une étoile suivie de 5 chiffres
OU
de six chiffres uniquement.
Il convient dont à mon avis de tester le format de la cellule en entier.
Messages postés
11
Date d'inscription
mercredi 9 avril 2008
Statut
Membre
Dernière intervention
11 avril 2008

Merci Bigfish, ton code est opérationnel :) il a repris l'ensemble des cellules commençant par *00000, cependant, il a oublié de reprendre les cellules 000000 (à 6chiffres) comme l'a fait remarqué Firelion. Il y a un autre souci: il arrondi les valeurs des cellules de la colonne 9 à l'unité. Je ne vois pas vraiment pourquoi, j'ai pourtant remis le format de cette colonne en "nombre" de même que la colonne
originale sur la Feuil1.
thx!
Messages postés
11
Date d'inscription
mercredi 9 avril 2008
Statut
Membre
Dernière intervention
11 avril 2008

Et merci aussi a Firelion ;)