Discussion :

[isfet]

bonjour

j'ai fait une fonction de tri selon une page comportant un dictionnaire à l'aide de la fonction cells.find

si la la recherche est infructueuse une erreur apparait

j'ai donc mis une gestion d'erreur qui me renvoi plus bas dans ma fonction, problème : ce la ne marche qu'une seule fois avec mon code

object variable or with block not set sur la ligne de mon cells.find quand il tombe sur une deuxieme valeur incorrecte

voici le bout de code en question

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Function tri()
 
Sheets("dictionnaire").Activate
Range("B1").Select
 
On Error GoTo voie_inexistante
While ActiveCell <> ""  'tant que nous n'avons pas parcouru tout le dictionnaire
    If ActiveCell.Offset(0, 1) = "" Then 'cette voie n'a pas été triée 'si elle n'a pas de valeurs a droite de son nom
    val_dico = Selection.Columns("A:A") 'on recupere le nom de la voie de notre sélection
    Sheets("data").Activate 'on retourne sur nos 1000 voies
    Range("B1").Select 'on selectionne le nom de la première voie
 
     Cells.Find(What:=val_dico, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
     Range(Selection.Offset(0, 1), Selection.End(xlToRight)).Select 'si oui, on se décale d'une  cellule vers la droite (pas besoin du nom) et on prends tout les points en etirant la sélection
     Selection.Copy 'on la copie
     Sheets("dictionnaire").Activate 'on retourne sur notre dictionnaire
     Selection.Offset(0, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'on colle notre ligne copiée
     Selection.Offset(0, -1).Select ' et on retourne sur le nom de la voie du dictionnaire
           End If
voie_inexistante:
Err.Clear
Sheets("Dictionnaire").Activate 'nous sommes sortis de la boucle, cad que notre valeur de dico a été trouvé
Selection.Offset(1, 0).Select 'alors on passe a la val dico suivant
Wend
 
End Function

pourriez vous m'aider a corriger mon problème ?

merci

[zyhack]

Bonjour

Code complétement remanié

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub tri()
Dim wsh1 As Worksheet, wsh2 As Worksheet
Dim ligne As Long, C As Range, plage As Range
 
ligne = 1
Set plage = Worksheets("data").Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
With Worksheets("dictionnaire")
  While .Cells(ligne, 2) <> "" 'tant que nous n'avons pas parcouru tout le dictionnaire
    If .Cells(ligne, 3) = "" Then 'cette voie n'a pas été triée 'si elle n'a pas de valeurs a droite de son nom
      Set C = plage.Find(.Cells(ligne, 2), LookIn:=xlValues, LookAt:=xlWhole) ' recherche dans les data
      If Not C Is Nothing Then ' la correspondance à été trouvé
        Worksheets("data").Range(Cells(C.Row, 3), Cells(C.Row, Cells(C.Row, Columns.Count).End(xlToLeft).Column)).Copy
        .Cells(ligne, 3).PasteSpecial Paste:=xlPasteAll
      End If
    End If
  ligne = ligne + 1
  Wend
End With
 
Set C = Nothing
Set plage = Nothing
 
End Sub

[mercatog]

Salut,
je n'ai pas apprécié cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Worksheets("data").Range(Cells(C.Row, 3), Cells(C.Row, Cells(C.Row, Columns.Count).End(xlToLeft).Column)).Copy

les Cells se reportent à quelle feuille?

[zyhack]

Bonjour mercatog

effectivement, quand j'ai fais mon essai la feuille "data était active donc je ne me suis pas aperçu qu'il y aurais un problème.

aurais-tu une idée pour simplifier un peu cette ligne ?

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set ws=Worksheets("data")

ou
tu peux utiliser des With imbriquées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
With Worksheets("dictionnaire")
 ....
        with Worksheets("data")
            .Range(.Cells(C.Row, 3), .Cells(C.Row, .Cells(C.Row, .Columns.Count).End(xlToLeft).Column)).Copy
       end with
       .Cells(ligne, 3).PasteSpecial Paste:=xlPasteAll
 ......
 
End With

[zyhack]

Un grand merci a mercatog

il est vrai que j'aime bien ta méthode de codage et j'essaye d'en maitriser certain rouage pour rendre les codes plus clair mais ce n'est pas encore très facile.

bref, voici le code modifié et testé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub tri()
Dim wsh1 As Worksheet, wsh2 As Worksheet
Dim ligne As Long, C As Range, plage As Range
 
ligne = 1
Set wsh1 = Worksheets("dictionnaire")
Set wsh2 = Worksheets("data")
Set plage = Worksheets("data").Range("B1:B" & wsh2.Cells(Rows.Count, 2).End(xlUp).Row)
With wsh1
  While .Cells(ligne, 2) <> "" 'tant que nous n'avons pas parcouru tout le dictionnaire
    If .Cells(ligne, 3) = "" Then 'cette voie n'a pas été triée 'si elle n'a pas de valeurs a droite de son nom
      Set C = plage.Find(.Cells(ligne, 2), LookIn:=xlValues, LookAt:=xlWhole) ' recherche dans les data
      If Not C Is Nothing Then ' la correspondance à été trouvé
        wsh2.Range(wsh2.Cells(C.Row, 3), wsh2.Cells(C.Row, wsh2.Cells(C.Row, wsh2.Columns.Count).End(xlToLeft).Column)).Copy
        .Cells(ligne, 3).PasteSpecial Paste:=xlPasteAll
      End If
    End If
  ligne = ligne + 1
  Wend
End With
 
Set C = Nothing
Set plage = Nothing
 
End Sub

encore merci