Macro sub VBARésolu

Question

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 *00008 text2 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 *00008 * 5488 text2 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!

bigfish_le vrai · Accepted Answer

... 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+

azg0rth · Answer

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!

Firelion · Answer

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.

azg0rth · Answer

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!

azg0rth · Answer

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?

Firelion · Answer

Re,
Quelle ligne du code est surlignée quand tu fais débogage?

azg0rth · Answer

Re Re
Aucune ligne n'est surlignée, c'est ca le problème.
:(

Firelion · Answer

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

Firelion · Answer

Excuse moi j'ai oublié le End Sub à la fin

azg0rth · Answer

Ca me renvoit le même message d'erreur

Firelion · Answer

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.

azg0rth · Answer

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!

azg0rth · Answer

[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

azg0rth · Answer

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++

Firelion · Answer

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+

Firelion · Answer

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

bigfish_le vrai · Answer

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+

Firelion · Answer

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.

azg0rth · Answer

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!

azg0rth · Answer

Et merci aussi a Firelion ;)

Macro sub VBA

20 réponses

Votre réponse