> Tous les forums > Forum Bureautique
 Créer une boucleSujet résolu
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
cedsevper
  Posté le 13/09/2007 @ 20:49 
Aller en bas de la page 
Petit astucien

Bonsoir à tous, j'ai besoin d'aide car je bute sur le problème de boucle depuis plusieurs jours, je ne suis pas un pro de VBA et ça se voit ;-)

Voici mon problème :

1) j'ai un fichier excel avec les données suivantes :

_ voiture 1

_ voiture 2

_ voiture 1

_ camion 3

_ voiture 1

2) j'ai fait une macro qui cherche "_ " ( sans les termes derrières) et qui copie la ligne trouvée dans une autre feuille

3) mais ma macro s'arrete sur la premiere valeur mais j'aimerai qu'elle cherche chaque valeur et les copies les unes derrière les autres sur l'autre feuille

exemple: dans la feuille 2 : _ voiture 1

_ voiture 2

_ camion 3

4)voici ma macro:

Sub essai()
Dim Var As String
On Error Resume Next
Var = ("_")
Set mottrouvé = Cells.Find(What:=Var)
If Not mottrouvé Is Nothing Then
mottrouvé.Select
val1 = Selection.Value
Sheets("d").Select
Range("a65000").Select
Selection.End(xlUp).Offset(1, 0).Select
Selection.Value = val1
Sheets("a").Activate

Dim LigVar, ColVar
LigVar = 1
Selection.Offset(LigVar, ColVar).Select
val2 = Selection.Value
Sheets("d").Activate
Range("b65000").Select
Selection.End(xlUp).Offset(1, 0).Select
Selection.Value = val2
End If
End Sub

Pouvez-vous m'aider, m'indiquer une piste, me sortir de mon bourbier.

Merci à tous

Publicité
galopin01
 Posté le 13/09/2007 à 21:39 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

bonjour,

Pas trop compris ton machin. Pour ce genre de question un classeur joint est incontournable.

Cette macro copie dans feuil2 les éléments trouvés dans Feuil1 (avec un léger désordre du à la méthode utilisée -Find- )

Sub essai()
Dim FirstAddress$, i&, c
i = Sheets("Feuil2").Range("a65000").End(xlUp)(2).Row
On Error Resume Next
With Sheets("Feuil1").Range("A1:A100")
Set c = .Cells.Find("_", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Sheets("Feuil2").Range("A" & i) = c.Value
Set c = .FindNext(c)
i = i + 1
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub

Mais j'ai peut-être pas tout compris...

A+

cedsevper
 Posté le 13/09/2007 à 22:38 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Merci pour votre réponse

je veux bien vous joindre un fichier mais je ne sais pas comment faire

galopin01
 Posté le 13/09/2007 à 22:49 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

bonsoir,,

Upload ton fichier dans cjoint et colle le lien dans ta réponse (après avoir cliqué sur Créer le lien cjoint ce lien est mémorisé dans ton presse papier : YAPUKA le coller dans ton topic)

...Mais tu pourrais déjà commencer à tester la macro YAKA remplacer le nom des feuilles et ça devrait le faire !

A+

cedsevper
 Posté le 13/09/2007 à 22:59 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

voici le fichier, je teste en parallele votre macro.

http://cjoint.com/?jnw51njtmH

galopin01
 Posté le 14/09/2007 à 06:27 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

bonjour,

La solution :

Sub essai()
Dim i&, k&, s$, o
On Error Resume Next
i = Sheets("d").Range("a65000").End(xlUp)(2).Row
On Error Resume Next
For Each o In Selection
s = o.Value: k = InStr(s, " . ")
If k > 0 Then
Sheets("d").Range("A" & i) = s
s = o.Offset(1).Value: k = InStr(s, Chr(151))
If k > 0 Then
Sheets("d").Range("B" & i) = s
End If
i = i + 1
End If
Next
End Sub

Nota: la macro travaille sur la sélection en cours. Il convient donc de sélectionner d'abord toute la colonne à traiter...

A+



Modifié par galopin01 le 14/09/2007 06:43
cedsevper
 Posté le 14/09/2007 à 20:53 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Merci beaucoup, c'est génial ça fonctionne à merveille.

Total respect

Page : [1] 
Page 1 sur 1

Vous devez être connecté pour participer à la discussion.
Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !
Recevoir PC Astuces par e-mail


La Lettre quotidienne +226 000 inscrits
Avec l'actu, des logiciels, des applis, des astuces, des bons plans, ...

Les bonnes affaires
Une fois par semaine, un récap des meilleurs offres.

Les fonds d'écran
De jolies photos pour personnaliser votre bureau. Une fois par semaine.

Les nouveaux Bons Plans
Des notifications pour ne pas rater les bons plans publiés sur le site.

Les bons plans du moment PC Astuces

Tous les Bons Plans
56,94 €Switch Netgear GS316, 16 ports gigabits à 56,94 €
Valable jusqu'au 20 Avril

Amazon propose actuellement le commutateur 16 ports Netgear GS316 à 56,94 € livré gratuitement alors qu'on le trouve ailleurs à partir de 75 €. Le Netgear GS316 bénéficie de 16 connexions Ethernet haut débit commutées à 10/100/1000 Mbps en full-duplex ce qui vous permet de transférer vos fichiers sur votre réseau local à une vitesse maximum sur chaque port. 


> Voir l'offre
259 €PC Ankermann (Intel Pentium Dual Core, 8Go RAM, SSD 480Go, Win 10 + Office 2019) à 259 € livré
Valable jusqu'au 18 Avril

Amazon fait une promotion sur l'ordinateur de bureau Ankermann Silent PC Work à 259 € livré. Le PC est équipé d'un processeur Intel Pentium dual core à 2.7 GHz, de 8 Go de RAM, d'un SSD de 480 Go, d'un lecteur DVD, d'un lecteur de carte mémoires et tourne sous Windows 10 Pro 64 bits. Microsoft Office 2019 Pro en français est également fourni.

Ajoutez un écran (comme cet écran 24 pouces ViewSonic VA2418 (FullHD, IPS, 75 Hz) à 99,99 €) et un pack clavier souris (comme ce pack filaire Logitech MK120 à 17,99 €) et vous avez un PC complet à l'aise en bureautique et Internet. Garantie 2 ans.


> Voir l'offre
309,99 €Ecran Lenovo 27 pouces G27Q-20 (WQHD, IPS, 165 Hz, FreeSync) à 309,99 €
Valable jusqu'au 18 Avril

Fnac propose actuellement l'écran 27 pouces Lenovo G27Q-20 à 309,99 € alors qu'on le trouve ailleurs à plus de 399 €. Cet écran dispose d'une dalle QHD (2560x1440) à bords fins, avec un temps de réponse de 1 ms et un rafraichissement de 165 Hz. Il possède des entrées DP et HDMI. Il est compatible Freesync et GSync. Il est réglable en hauteur et en inclinaison et est garanti 3 ans.


> Voir l'offre

Sujets relatifs
créer un calcul en boucle dans excel
logiciel pour créer son faire part
Creation d' une boucle macro dans fichier EXCEL pour impression
Créer un fichier xls suivant des données de scripts
Créer duplicata
Comment créer fichier client avec carte de fidélité
Macro pour créer un Gencode sur Excel - EAN 18
Outlook 2007 Comment creer groupe adresse
Créer un lien hypertexte vba
Créer un sommaire cliquable sur PDF
Plus de sujets relatifs à Créer une boucle
 > Tous les forums > Forum Bureautique