Prb dans une fonction d'extraction sous condition de fichier excel.

**insosama** · 03/09/2013, 22h01

Bonjour

j'ai un bug dans un algo pourtant pas si délicat que ca, je ne comprend pas vraiment pourquoi. j'ai meme deux bug, mais j'ai réglé le premier de facon bourrine sans comprendre la cause.

bon, avant de détailler les deux bugs, et de donner le code source, je détaille le but du code pour que vous puissiez l'essayer proprement.

il s'agit d'un code implanté dans un module qui "retourne" une valeur. autrement dit, une formule exploitable directement dans une cellule d'excel
=Find_Of_File(....)

son but est d'ouvrir un fichier excel, dont l'adresse est une variable
sur un classeur (sheet) lui meme en variable

dans ce classeur, apres avoir identifié la "zone de travail", on cherche les cellules ou on trouve un texte entré en variable dans la formule de base (Find_Of_Text)
elle retourne alors la valeur d'une cellule situé a un Offset row, colums déterminé aussi dans les variables de la formule.

optionnellement, on peu également donner un second offset r,c non pour retourner la valeur, mais verrifier que cette cellule contient également un terme recherché défini en variable.

par l'exemple,
Function Find_On_File(path As String, file As String, sheet As String, Mots As Variant, Optional Column_Offset As Long, Optional Row_Offset As Long, Optional ScdValue_Row As Long, Optional ScdValue_Collumn As Long, Optional ScdValue As Variant)

=Find_On_File("C:\mes docs\taf", "boulot.xls", "feuil1", "perceuse", 1, 0, 2, 3, "Electrique")

doit chercher dans le document c:\mes docs\taf\boulot.xls#feuil1
le terme "perceuse"

si et seulement si la cellule situé a 2 ligne au dessous et 3 colonne a droite de la cellule contenant "perceuse" contient elle meme "electrique",

alors retourner en résultat la valeur de la cellule situé a 1 colone a gauche et la meme ligne que la cellule contentant "perceuse".

voici le code qui permet (en théorie) de faire ceci :

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
 
Function Find_On_File(path As String, file As String, sheet As String, Mots As Variant, Optional Column_Offset As Long, Optional Row_Offset As Long, Optional ScdValue_Row As Long, Optional ScdValue_Collumn As Long, Optional ScdValue As Variant) As Variant
 
    If InStr(1, path & "\" & file, "\\") <> 0 Then
        fichier = path & file
    Else
        fichier = path & "\" & file
    End If
 
    Dim wb As Workbook
    Dim sht, plage As Range
    Dim Each_Cellule As Range
    Dim x, y As Long
 
            Set wb = GetObject(fichier)
 
            Set sht = Find_limit_Range(wb.Sheets(sheet))
            Set plage = FnTrouveMotDansPlage(Mots, (sht))
 
            For Each Each_Cellule In plage
 
                x = Each_Cellule.Column
                y = Each_Cellule.Row
 
                If ScdValue_Row <> 0 And ScdValue_Collumn <> 0 And ScdValue <> "" Then
                    If InStr(1, UCase(sht.Range(Cells(y + ScdValue_Row, x + ScdValue_Collumn)).Value), UCase(ScdValue), vbTextCompare) <> 0 Then
                        'good !
                            Find_On_File = wb.Sheets(sheet).Range(Cells(y + Row_Offset, x + Column_Offset)).Value
                        'on sort
                            Exit For
                    Else
                        'not good !
                    End If
                Else
                    'good (dans tout les cas)
                        Find_On_File = wb.Sheets(sheet).Range(Cells(y + Row_Offset, x + Column_Offset)).Value
                    'on sort
                        Exit For
                End If
 
            Next
 
 
 
            Find_On_File = wb.Sheets(sheet).Range(Cells(y, x)).Value
 
    wb.Close
    wb = Nothing
 
 
End Function
 
Function Find_limit_Range(FindOn As Sheets, Optional Offset As Integer) As Range
 
    Dim max, i As Long
    Dim DrnCln, MaxLgn, LastCln As Long
    Dim Lgn() As Long
    Dim Good As Boolean
 
    If Offset = "" Then
        max = 10 'offset vide cherché; plus il est large, plus c'est long; moins il l'est, plus le risque de zapper des zones de fichier est grand.
    Else
        max = Offset
    End If
 
    Good = False
 
    i = 1
    DrnCln = 1
    MaxLgn = 1
 
 
    Do While Good = False
 
        Do While i < max
 
            ReDim Lgn(DrnCln)
            Lgn(DrnCln) = Cells(Rows.Count, DrnCln).End(xlUp).Row 'releve la derniere ligne de la colone en cours
            If Lgn(DrnCln) = 1 Then
                i = i + 1
            Else
                If Lgn(DrnCln) > MaxLgn Then MaxLgn = Lgn(DrnCln)
                i = 1
            End If
 
            DrnCln = DrnCln + 1
 
        Loop
 
        'on a trouvé "une" derniere colone, et la ligne max.
 
        DrnCln = DrnCln - 10
        LastCln = Cells(MaxLgn, 256).End(xlToLeft).Column 'on cherche la derniere colone occupé a la ligne max trouvé
 
        'on confirme que les deux concorde, puis soit on reboucle, soit on valide.
        If LastCln > DrnCln Then 'à la derniere ligne, on trouve une colone plus loin
            DrnCln = LastCln
            i = 1
        Else 'on confirme
            Good = True
        End If
 
    Loop
 
    Set Find_limit_Range = Range(Cells(1, 1), Cells(DrnCln, MaxLgn))
 
 
End Function
 
 
Function FnTrouveMotDansPlage(sMot As Variant, rPlage As Range)
'auteur de cette fonction : MichelBerthiaume
'retourne une plage formée de chaque cellule de rPlage contenant sMot
 
    Dim rTrouve As Range 'contiendra les cellules trouvées
    Dim rCellule As Range 'contiendra a tour de role chaque cellule cherchée
 
 
        For Each rCellule In rPlage
            If InStr(UCase(rCellule.Value), UCase(sMot)) <> 0 Then
                If rTrouve Is Nothing Then
                    Set rTrouve = rCellule
                Else
                    Set rTrouve = Union(rTrouve, rCellule)
                End If
            End If
        Next
 
    Set FnTrouveMotDansPlage = rTrouve
 
End Function

vous remarquerez qu'une partie n'est pas de moi.

elle contient trois fonction

- Find_On_File, celle évoqué au dessus dont son fonctionnement est a peu pret celui évoqué dans mon "algo-ecrit-en-francais" évoqué au dessus, et qui appelle elle meme deux sous fonctions :

- Find_Limit_Range
qui retourne en théorie la plage utilisé sur un classeur défini. on peu entrer en parametre un curseur de "sensibilité" (réglé par défaut a 10 et ici laissé tel quel)
il est basé sur un algo que j'utilisais avant (que j'ai écrit), mais que j'ai réécrit de mémoire (pas moyen de le retrouver)
en théorie, il fonctionne, donc, mais allez donc savoir une coquille s'est peut etre glisser dedans. de fait, le programme plante bien avant d'en arriver la, donc je ne sais pas ce qu'il en est.

- FnTrouveMotDansPlage
retourne un objet range contenant une ou plusieurs cellule avec un mot recherché en particulier dans une plage donnée. je l'ai deja utilisé dans le passé, et je l'ai copié tel quel, donc se doit d'etre fonctionnel. j'ai laissé le nom de la personne qui a proposé ces quelques lignes.

LES DEUX PROBLEMES :
1) j'avais un probleme "ByRef", qui normalement désigne une incompatibilité entre deux définition de variable (quand on essaye d'attribuer un "long" dans un "range".
celui intervenait dès le début du code :

Code :

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

1
2
 
Set plage = FnTrouveMotDansPlage(Mots, sht)

hors sht est un objet range, en tout cas défini comme tel
il est chargé par l'objet range de "find_limit_range"

Code :

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

1
2
 
Set sht = Find_limit_Range(wb.Sheets(sheet))

et la fonction FnTrouveMotDansPlage attend bien un argument Range

Code :

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

1
2
 
Function FnTrouveMotDansPlage(sMot As Variant, rPlage As Range)

donc ... ou est char... heu ... l'erreur ?
à défaut j'ai forcé la main en ajoutant les parenthese miracle autour de mon argument :

Code :

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

1
2
3
4
5
 
'ce code planté ...
Set plage = FnTrouveMotDansPlage(Mots, sht)
'devient :
Set plage = FnTrouveMotDansPlage(Mots, (sht))

mais tout comme je hais les sudoku soluble qu'a force de test et non de reflexion, je n'aime pas ne pas comprendre "ou" est le soucis.

bon, second soucis :
une fois que j'ai forcé la main avec (sht) ... le mode debug s'arrete a une ligne en particulier, et apres un petit lag, sans raison, reboucle visiblement au début de la fonction... et la ... je ne pige VRAIMENT pas.

la ligne en question est juste avant :

Code :

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

1
2
 
Set sht = Find_limit_Range(wb.Sheets(sheet))

je tiens a préciser que la mise en valeur en jaune RESTE sur cette ligne et ne passe JAMAIS sur la fonction find_limite_range.
et mettre un point d'arret sur cette meme fonction n'y change rien. apres quelques secondes de lag, soit elle disparait (et la fonction s'arrete sans raison), soit elle revient au tout début de la fonction "find_on_file"
le comportement ressemblerait a un "on error resume next" avec une erreur provoqué dès ma déclaration d'appel de fonction ... sauf que je n'ai aucune "on error resume next"

voila... quelqu'un peut il trouver ce qui ne va pas dans ce petit code ? (qui une fois débuggé, je l'espere, pourra servir a d'autre personne, qui sait ?)

**SfJ5Rpw8** · 03/09/2013, 22h09

bonsoir,

j'ai pas tout lu .. sht semble être la source ton problème et celui-ci est mal déclaré

en VB l'écriture suivante :

Code :

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

  Dim sht, plage As Range

déclare sht de type variant et plage de type range ...

lors d'une déclaration il faut répéter le type pour chacune des variables :

Code :

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

  Dim sht as range, plage As Range

**insosama** · 03/09/2013, 22h19

voila qui répond a ma question sur Sht.
merci deja

j'ai donc tout recodé rapidement, mais cela ne suffit par contre pas a éviter le problème de l'arret du code sur "Set Sht = Find ..."
alors que j'ai franchement cru en te lisant que ca pouvait bien "tout expliquer"

donc problème 1 réglé, mais le 2 persiste.

d'autres idée ?

pour info, le nouveau code : (j'ai viré les parenthese dans la foulée)

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
 
Function Find_On_File(path As String, file As String, sheet As String, Mots As Variant, Optional Column_Offset As Long, Optional Row_Offset As Long, Optional ScdValue_Row As Long, Optional ScdValue_Collumn As Long, Optional ScdValue As Variant) As Variant
 
    If InStr(1, path & "\" & file, "\\") <> 0 Then
        fichier = path & file
    Else
        fichier = path & "\" & file
    End If
 
    Dim wb As Workbook
    Dim sht As Range
    Dim plage As Range
    Dim Each_Cellule As Range
    Dim x As Long
    Dim y As Long
 
            Set wb = GetObject(fichier)
 
            Set sht = Find_limit_Range(wb.Sheets(sheet))
            Set plage = FnTrouveMotDansPlage(Mots, sht)
 
            For Each Each_Cellule In plage
 
                x = Each_Cellule.Column
                y = Each_Cellule.Row
 
                If ScdValue_Row <> 0 And ScdValue_Collumn <> 0 And ScdValue <> "" Then
                    If InStr(1, UCase(sht.Range(Cells(y + ScdValue_Row, x + ScdValue_Collumn)).Value), UCase(ScdValue), vbTextCompare) <> 0 Then
                        'good !
                            Find_On_File = wb.Sheets(sheet).Range(Cells(y + Row_Offset, x + Column_Offset)).Value
                        'on sort
                            Exit For
                    Else
                        'not good !
                    End If
                Else
                    'good (dans tout les cas)
                        Find_On_File = wb.Sheets(sheet).Range(Cells(y + Row_Offset, x + Column_Offset)).Value
                    'on sort
                        Exit For
                End If
 
            Next
 
 
 
            Find_On_File = wb.Sheets(sheet).Range(Cells(y, x)).Value
 
    wb.Close
    wb = Nothing
 
 
End Function
 
Function Find_limit_Range(FindOn As Sheets, Optional Offset As Integer) As Range
 
    Dim max, i As Long
    Dim DrnCln As Long
    Dim MaxLgn As Long
    Dim LastCln As Long
    Dim Lgn() As Long
    Dim Good As Boolean
 
    If Offset = "" Then
        max = 10 'offset vide cherché; plus il est large, plus c'est long; moins il l'est, plus le risque de zapper des zones de fichier est grand.
    Else
        max = Offset
    End If
 
    Good = False
 
    i = 1
    DrnCln = 1
    MaxLgn = 1
 
 
    Do While Good = False
 
        Do While i < max
 
            ReDim Lgn(DrnCln)
            Lgn(DrnCln) = Cells(Rows.Count, DrnCln).End(xlUp).Row 'releve la derniere ligne de la colone en cours
            If Lgn(DrnCln) = 1 Then
                i = i + 1
            Else
                If Lgn(DrnCln) > MaxLgn Then MaxLgn = Lgn(DrnCln)
                i = 1
            End If
 
            DrnCln = DrnCln + 1
 
        Loop
 
        'on a trouvé "une" derniere colone, et la ligne max.
 
        DrnCln = DrnCln - 10
        LastCln = Cells(MaxLgn, 256).End(xlToLeft).Column 'on cherche la derniere colone occupé a la ligne max trouvé
 
        'on confirme que les deux concorde, puis soit on reboucle, soit on valide.
        If LastCln > DrnCln Then 'à la derniere ligne, on trouve une colone plus loin
            DrnCln = LastCln
            i = 1
        Else 'on confirme
            Good = True
        End If
 
    Loop
 
    Set Find_limit_Range = Range(Cells(1, 1), Cells(DrnCln, MaxLgn))
 
 
End Function
 
 
Function FnTrouveMotDansPlage(sMot As Variant, rPlage As Range)
'auteur de cette fonction : MichelBerthiaume
'retourne une plage formée de chaque cellule de rPlage contenant sMot
 
    Dim rTrouve As Range 'contiendra les cellules trouvées
    Dim rCellule As Range 'contiendra a tour de role chaque cellule cherchée
 
 
        For Each rCellule In rPlage
            If InStr(UCase(rCellule.Value), UCase(sMot)) <> 0 Then
                If rTrouve Is Nothing Then
                    Set rTrouve = rCellule
                Else
                    Set rTrouve = Union(rTrouve, rCellule)
                End If
            End If
        Next
 
    Set FnTrouveMotDansPlage = rTrouve
 
End Function

**SfJ5Rpw8** · 03/09/2013, 22h24

tu as encore des problèmes de type de données !

je comprends pas pourquoi tu n'as pas de message d'erreur ?

ta fonction réclame une collection de feuilles (sheets) et tu ne lui passe qu'une feuille !

**insosama** · 03/09/2013, 22h37

ptdr
décidément, merci !
quitte par contre a me faire passer pour un noob (apres tout j'en suis pas loin xD) heu ... peux tu s'il te plait expliciter les zones a modifier, et surtout par quoi ?

je sais, ca fait un peu celui qui ne veu pas faire d'effort, je le regrette, mais j'avoue que la, je me mélange les pinceaux de plus en plus (c'est pas la seule fonction sur laquelle je bosse actuellement >_< et l'autre me bouffe toute mes neurones)
j'avoue que je deteste excel et ses subtilité, ou tanto un "range(cells(x,y)).interior" ne marche pas alors que le cells(x,y).interior fonctionne, et j'en passe ...

j'ai par contre en théorie très bien compris ce que tu me dis, et c'est effictivement certainement la cause du soucis.
par contre, ce que je cherche est bien d'envoyer un seul classeur. c'est donc le fait que ma fonction en attende plusieurs qui est une coquille

un dernier coup de main, donc ? (en m'excusant de mes manieres cavalieres)

(ps : mon autre code est en bonne voie ... et il pourrait servir a pas mal de monde ... on publie ca ou ?)

Edit : apres reflexion, j'ai fini par retrouver mes élémentaires ...
As sheets est donc devenu ... as worksheet

Function Find_limit_Range(FindOn As Worksheet, Optional Offset As Integer) As Range

techniquement, cette fois ci, ca doit fonctioner, non ?

et bien ... NON !

décidement ... je comprend pas. pourquoi j'en ch*** sur trois ligne de code ? xD

de l'aide siou plai ???

Prb dans une fonction d'extraction sous condition de fichier excel.

Macros et VBA Excel

Discussions similaires

Partager

Partager