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
|
' /\
' /| \ ne pas oublier les référence à Excel (Outils/Références/"Microsoft Excel 11.0 ObjectLibrary")
'/_.__\
Private Function ValeurCaseGauche(P_NomFeuille As String, P_Range As String, P_MotRecherche As String, P_NbCaseAGauche As Integer) As Variant
'on recherc le text passé par le paramêtre "P_MotRecherche" dans la zone de sélection défini par "P_Range"
'Si on le trouve on remonte de "P_NbCaseAGauche" sur la gauche et on renvoie la valeur
'Si c'est une cellule fusionné on renvoie la valeur contenut dans la case la plus en haut à gauche de la fusion
'dans tous les cas on renvoie le nombre de valeur trouvé à l'adresse (0,2) du tableau de résultats
'dans tous les cas on renvoie le numéro de ligne de la première valeur trouvé à l'adresse (0,3) du tableau de résultats
'dans tous les cas on renvoie le numéro de colonne de la première valeur trouvé à l'adresse (0,4) du tableau de résultats
'dans tous les cas on renvoie le nombre de valeur de case à gauche <> "" à l'adresse (0,1) du tableau de résultats
Dim RGE_C As Range 'Permet de faire la recherche
Dim STR_FA As String 'contient l'adresse du premier résultat de la recherche
Dim STR_Cel As String 'récupère le contenut d'une cellule renvoié par la recherche
Dim TAB_Res(0 To 50, 1 To 4) As Variant 'contient la liste des tous les résultats de la recherche
Dim INT_i As Integer 'Incrément
Dim INT_Nb As Integer 'contient le nombre de fois que la chaine de caractère recherché à été trouvée
'OBJ_Classeur_Excel est une variable global qui s'inititalise comme ça :
'Dim OBJ_Appli_Excel As Excel.Application 'pour l'utilisation du fichier Excel
'Dim OBJ_Classeur_Excel As Excel.Workbook 'pour l'utilisation du fichier Excel
'Set OBJ_Appli_Excel = CreateObject("Excel.Application")
'enlève les messages d'alertes
'OBJ_Appli_Excel.DisplayAlerts = False
'Set OBJ_Classeur_Excel = OBJ_Appli_Excel.Workbooks.Open(Filename:="Chemin\de\mon\fichier.xls/xlt")
With OBJ_Classeur_Excel.Sheets(P_NomFeuille).Range(P_Range)
'on recherche le mot passé en paramêtre
Set RGE_C = .Find(P_MotRecherche, LookIn:=xlValues, LookAt:=xlPart)
INT_i = 0
INT_Nb = 0
If (Not RGE_C Is Nothing) Then
'on stock la première adresse pour ne pas rechercher en boucle
STR_FA = RGE_C.Address
'on stock le numéro de la ligne et de la colonne de la première cellule trouvé
TAB_Res(0, 3) = RGE_C.Row
TAB_Res(0, 4) = RGE_C.Column
'on récupère une première fois la valeurs contenut "P_NbCaseAGauche" puis on boucle tant qu'on trouve la chaine recherché
Do
'on incrément le nombre de fois que la chaine de caractère a été trouvé
INT_Nb = INT_Nb + 1
'on récupère le contenut de la cellule, Si c'est une cellule fusionné on récupère la valeur de la cellule la plus à gauche
If ((RGE_C.Column - P_NbCaseAGauche) > 0) Then
STR_Cel = OBJ_Classeur_Excel.Sheets(P_NomFeuille).Range("A1:AA1000").Cells(RGE_C.Row, RGE_C.Column - P_NbCaseAGauche).MergeArea.Cells(1, 1).Value
Else
STR_Cel = ""
End If
If ((Not IsNull(STR_Cel)) And (STR_Cel <> "")) Then
INT_i = INT_i + 1
TAB_Res(INT_i, 1) = STR_Cel
TAB_Res(INT_i, 2) = RGE_C.Address
TAB_Res(INT_i, 3) = RGE_C.Row
TAB_Res(INT_i, 4) = RGE_C.Column
End If
Set RGE_C = .FindNext(RGE_C)
Loop While ((Not RGE_C Is Nothing) And (RGE_C.Address <> STR_FA))
End If
End With
'l'adresse du tableau (0.1) permet de stocker le nombre d'éléments actif dans le tableau
TAB_Res(0, 1) = INT_i
'l'adresse du tableau (0.2) permet de stocker le nombre de fois qu'a été trouvé la chaine de caractère
TAB_Res(0, 2) = INT_Nb
If (INT_i = 0) Then
TAB_Res(1, 1) = ""
End If
'on retourne le résultat
ValeurCaseGauche = TAB_Res
End Function |
Rechercher une valeur dans fichier Excel depuis VBA Access
Répondre avec citation
Partager