VBA : Chercher valeur dans une boucle
Résolu/Fermé
BretonBeurre
Messages postés
12
Date d'inscription
vendredi 12 octobre 2018
Statut
Membre
Dernière intervention
22 octobre 2018
-
18 oct. 2018 à 15:45
BretonBeurre Messages postés 12 Date d'inscription vendredi 12 octobre 2018 Statut Membre Dernière intervention 22 octobre 2018 - 22 oct. 2018 à 13:32
BretonBeurre Messages postés 12 Date d'inscription vendredi 12 octobre 2018 Statut Membre Dernière intervention 22 octobre 2018 - 22 oct. 2018 à 13:32
A voir également:
- VBA : Chercher valeur dans une boucle
- Mkdir vba ✓ - Forum VB / VBA
- Excel compter cellule couleur sans vba - Guide
- Vba range avec variable ✓ - Forum VB / VBA
- Autofill vba ✓ - Forum Excel
- L'indice n'appartient pas à la sélection vba ✓ - Forum Programmation
3 réponses
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 310
18 oct. 2018 à 16:49
18 oct. 2018 à 16:49
Bonjour,
Un extrait de ton classeur serait le bienvenu. pour cela:
Mettre le classeur sans données confidentielles en pièce jointe sur
https://mon-partage.fr/
Puis faire un clic « copier le raccourci » et lecoller dans votre message
Dans l’attente
Un extrait de ton classeur serait le bienvenu. pour cela:
Mettre le classeur sans données confidentielles en pièce jointe sur
https://mon-partage.fr/
Puis faire un clic « copier le raccourci » et lecoller dans votre message
Dans l’attente
ccm81
Messages postés
10905
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
27 décembre 2024
2 429
18 oct. 2018 à 20:15
18 oct. 2018 à 20:15
Bonjour
En attendant le retour de michel (amical salut)
Une proposition
https://www.cjoint.com/c/HJssnU8F1tB
Cdlmnt
En attendant le retour de michel (amical salut)
Une proposition
https://www.cjoint.com/c/HJssnU8F1tB
Cdlmnt
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 310
19 oct. 2018 à 08:36
19 oct. 2018 à 08:36
Salut ccm81,
Je te laisse le bébé ;o)
en effet, le code de Bretonbeurre va progressivement de 51 à 50*18 ce qui n'est pas le cas dans la pièce jointe où en plus il y a des numéros qui sont hors de cette progression comme 200 par exemple... pas très sérieux.
devant des demandes floues, maintenant , je laisse tomber;
Amicalement
Je te laisse le bébé ;o)
en effet, le code de Bretonbeurre va progressivement de 51 à 50*18 ce qui n'est pas le cas dans la pièce jointe où en plus il y a des numéros qui sont hors de cette progression comme 200 par exemple... pas très sérieux.
devant des demandes floues, maintenant , je laisse tomber;
Amicalement
BretonBeurre
Messages postés
12
Date d'inscription
vendredi 12 octobre 2018
Statut
Membre
Dernière intervention
22 octobre 2018
1
19 oct. 2018 à 09:26
19 oct. 2018 à 09:26
Bonjour,
Merci ccm81, ton code, en plus de bien fonctionner, m'apprend beaucoup de choses. Décidemment il faut vraiment spécifier au find où chercher, ce qui m'étonne car dans les sub précédents je n'avais pas à le faire. Même si j'avais trouvé un moyen pour que mon code fonctionne, je pense utiliser le tien car me permettra de mieux traiter si d'autres tableaux qui ne sont pas une puissance de 50 (Polyline 240 par exemple), dans les cas où je peux en avoir.
Michel_m, mon code va jusqu'à i=18 car en réalité je dois traiter jusqu'à la Polyline 900. Mais quand tu m'as demandé un fichier Excel je ne suis allé que jusqu'à la 200 pour ne pas avoir à tous les faire pour un fichier de test. Par contre je ne vois pas ce que tu veux dire par "le code va progressivement de 51 à 50*18". Normalement 50 reste constant, à moins que j'ai fait une erreur dans le premier code que je vous ai donné…
Cordialement
Merci ccm81, ton code, en plus de bien fonctionner, m'apprend beaucoup de choses. Décidemment il faut vraiment spécifier au find où chercher, ce qui m'étonne car dans les sub précédents je n'avais pas à le faire. Même si j'avais trouvé un moyen pour que mon code fonctionne, je pense utiliser le tien car me permettra de mieux traiter si d'autres tableaux qui ne sont pas une puissance de 50 (Polyline 240 par exemple), dans les cas où je peux en avoir.
Michel_m, mon code va jusqu'à i=18 car en réalité je dois traiter jusqu'à la Polyline 900. Mais quand tu m'as demandé un fichier Excel je ne suis allé que jusqu'à la 200 pour ne pas avoir à tous les faire pour un fichier de test. Par contre je ne vois pas ce que tu veux dire par "le code va progressivement de 51 à 50*18". Normalement 50 reste constant, à moins que j'ai fait une erreur dans le premier code que je vous ai donné…
Cordialement
ccm81
Messages postés
10905
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
27 décembre 2024
2 429
Modifié le 19 oct. 2018 à 20:38
Modifié le 19 oct. 2018 à 20:38
Il y a une solution pour transférer tous les tableaux X[mm] Polyline nn, quelque soit le nombre nn
Cdlmnt
Public Sub OK() Dim obj As Object, liobj As Long, premadr As String, adr As String Dim li1 As Long, li2 As Long, plage As Range Dim k As Long Application.ScreenUpdating = False With Sheets(FF) k = 0 Set obj = .Columns(coFF).Find(nom, , , xlPart) If Not obj Is Nothing Then premadr = obj.Address li1 = obj.Row li2 = li1 Do li2 = li2 + 1 Loop Until .Cells(li2, coFF) = "" Set plage = .Range(.Cells(li1, coFF), .Cells(li2 - 1, coFF + 1)) plage.Copy Sheets(FD).Cells(lidebFD, codebFD + k * (nbcoFF + 1)) k = k + 1 Do Set obj = .Columns(coFF).FindNext(obj) If Not obj Is Nothing Then adr = obj.Address If adr <> premadr Then li1 = obj.Row li2 = li1 Do li2 = li2 + 1 Loop Until .Cells(li2, coFF) = "" Set plage = .Range(.Cells(li1, coFF), .Cells(li2 - 1, coFF + 1)) plage.Copy Sheets(FD).Cells(lidebFD, codebFD + k * (nbcoFF + 1)) k = k + 1 End If End If Loop Until obj Is Nothing Or adr = premadr End If End With End Sub
Cdlmnt
BretonBeurre
Messages postés
12
Date d'inscription
vendredi 12 octobre 2018
Statut
Membre
Dernière intervention
22 octobre 2018
1
22 oct. 2018 à 13:17
22 oct. 2018 à 13:17
Merci pour la réponse, j'ai fini par faire un mix de ce que tu conseilles et de ce que j'avais, et ça fonctionne niquel !
Vu que j'ai toujours un pas de 50 sauf, parfois, pour le dernier tableau, je fais la boucle en faisant exprès de laisser le dernier. Puis je demande à chercher le prochain X[mm] pour déplacer ce dernier tableau (vu que je cut au lieu de copy).
C'est artisanal, mais je n'ai pas besoin d'un code qui cherche le nombre de tableaux pour faire le bon nombre de fois la boucle. Merci encore ccm81, tes codes m'ont bien aidé !
Vu que j'ai toujours un pas de 50 sauf, parfois, pour le dernier tableau, je fais la boucle en faisant exprès de laisser le dernier. Puis je demande à chercher le prochain X[mm] pour déplacer ce dernier tableau (vu que je cut au lieu de copy).
C'est artisanal, mais je n'ai pas besoin d'un code qui cherche le nombre de tableaux pour faire le bon nombre de fois la boucle. Merci encore ccm81, tes codes m'ont bien aidé !
BretonBeurre
Messages postés
12
Date d'inscription
vendredi 12 octobre 2018
Statut
Membre
Dernière intervention
22 octobre 2018
1
22 oct. 2018 à 13:32
22 oct. 2018 à 13:32
Je dépose ici le code que j'utilise. L'onglet où je colle mes tableaux porte le nom du fichier (d'où la définition de la variable FD).
Dim obj As Object Dim k As Long, nomTk As String, FD FD = Split(ActiveWorkbook.Name, ".") nom = "X[mm] Polyline " With Sheets("Feuil1") For k = 0 To 20 If k = 0 Then 'nom du fichier cherche nomTk = nom & "5" Else nomTk = nom & k * 50 End If Set obj = .Columns(1).Find(nomTk, , , xlWhole) 'Cherche chaque tableau Polyline If Not obj Is Nothing Then Cells(obj.Row, obj.Column).Select Range(ActiveCell, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Sheets(FD(0)).Cells(1, 1 + k * 2) 'Coupe le tableau/Colle dans la Feuil d'origine Else Set obj = .Columns(1).Find("X[mm]", , , xlPart) 'Cherche tableau Polyline autre que multiple de 50 If Not obj Is Nothing Then Cells(obj.Row, obj.Column).Select Range(ActiveCell, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Sheets(FD(0)).Cells(1, 1 + k * 2) 'Coupe le tableau/Colle dans la Feuil d'origine Else Application.DisplayAlerts = False Sheets("Feuil1").Delete Application.DisplayAlerts = True Exit Sub End If End If Next k End With End Sub
18 oct. 2018 à 17:10
Modifié le 18 oct. 2018 à 18:32