Menu

VBA : Chercher valeur dans une boucle [Résolu]

Messages postés
12
Date d'inscription
vendredi 12 octobre 2018
Dernière intervention
22 octobre 2018
- - Dernière réponse : BretonBeurre
Messages postés
12
Date d'inscription
vendredi 12 octobre 2018
Dernière intervention
22 octobre 2018
- 22 oct. 2018 à 13:32
Bonjour,

Je suis en train de rédiger une macro pour réorganiser les données d'un fichier Excell. Après plusieurs traitement, j'ai plusieurs tableaux de valeurs, les uns en-dessous des autres. J'aimerai les mettre tous les uns A COTE des autres, collés entre eux.

Pour cela j'ai écris ce code, qui cherche le premier tableau de ce que j'aimerai avoir en sortie, le cut/paste dans l'onglet final, puis retourne chercher chacun des tableaux suivants grâce à une boucle for (chacun des tableaux se nomment Polyline 5, Polyline 50, Polyline 100, Polyline 150, …).

Sub OrgCol()

Application.ScreenUpdating = False

Selection.Find(What:="Polyline 5", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Select
Range(ActiveCell, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Sheets("Destination").Select
Range("A1").Select
ActiveSheet.Paste

For i = 1 To 18
Sheets("Feuil1").Select
Range("A1").Select
Y = 50 * i
Selection.Find(What:="Polyline " & Y, After:=ActiveCell, LookIn:=xlValues _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range(ActiveCell, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Sheets("Destination").Select
ActiveCell.Offset(0, 2).Select
ActiveSheet.Paste
Next

Application.ScreenUpdating = True

End Sub


Sauf qu'arrivé au Find dans ma boucle, Excel me sort une erreur "Erreur d'exécution '91' : Variable objet, ou variable de bloc With non définie". Pourtant c'est exactement la même ligne de code que le premier Find (au What:= près), et même si je lui dis de ne chercher plus que la lettre P j'ai toujours cette erreur.

Quelqu'un aurait déjà rencontré cette erreur ? Des idées de solutions pour qu'il cherche bien ma valeur dans la boucle ?

Merci à vous

BretonBeurre


Afficher la suite 

Votre réponse

3 réponses

Messages postés
15674
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 février 2019
3607
0
Merci
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

BretonBeurre
Messages postés
12
Date d'inscription
vendredi 12 octobre 2018
Dernière intervention
22 octobre 2018
1 -
Merci pour la réponse. Voici le lien : https://mon-partage.fr/f/UByWXeOi/
BretonBeurre
Messages postés
12
Date d'inscription
vendredi 12 octobre 2018
Dernière intervention
22 octobre 2018
1 -
Après la macro précédente, j'avais sélectionné toutes les valeurs de ma Feuil1 (Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select). J'ai essayé de faire pareil avant le find de ma boucle, et ça a fonctionné. Je ne comprends pas pourquoi car normalement il devait chercher dans toute la feuille active, sans que j'ai à sélectionner une zone spécifique… Si tu trouves autre chose je suis tout ouï !
Commenter la réponse de michel_m
Messages postés
8775
Date d'inscription
lundi 18 octobre 2010
Dernière intervention
15 février 2019
1891
0
Merci
Bonjour

En attendant le retour de michel (amical salut)
Une proposition
https://www.cjoint.com/c/HJssnU8F1tB

Cdlmnt
michel_m
Messages postés
15674
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 février 2019
3607 -
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
BretonBeurre
Messages postés
12
Date d'inscription
vendredi 12 octobre 2018
Dernière intervention
22 octobre 2018
1 -
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
Commenter la réponse de ccm81
Messages postés
8775
Date d'inscription
lundi 18 octobre 2010
Dernière intervention
15 février 2019
1891
0
Merci
Il y a une solution pour transférer tous les tableaux X[mm] Polyline nn, quelque soit le nombre nn
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
Dernière intervention
22 octobre 2018
1 -
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é !
BretonBeurre
Messages postés
12
Date d'inscription
vendredi 12 octobre 2018
Dernière intervention
22 octobre 2018
1 -
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
Commenter la réponse de ccm81