| auteur : SilkyRoad |
Il est possible de faire une recherche par formule dans un classeur fermé.
La fonction suivante recherche la chaîne "DVP" dans la colonne A et affiche la donnée correspondante de la colonne B:
=RECHERCHEV("DVP";'C:\Documents and Settings\dossier\[ClasseurBase.xls]Feuil1'!$A:$B;2;FAUX)
|
| auteur : SilkyRoad |
Dans le tableur Excel, il est possible de lire le contenu d'une cellule d'un classeur fermé par formule:
Voire même d'y faire une recherche:
Par contre une question revient régulièrement: Lorsque le classeur à scruter est fermé, comment
utiliser la fonction Indirect dans ce type de formule?
Formule |
= INDIRECT (" 'C:\Documents and Settings\mimi\dossier\excel\[ " & C2& " ]Feuil1'!$A$1 " )
|
C2 étant la cellule qui contient le nom du classeur, la formule renvoie une erreur #REF!.
En effet, (CF l'aide Excel) si l'argument réf_texte fait référence à un autre classeur
(une référence externe), ce dernier doit être ouvert. Si le classeur auxiliaire est fermé, la fonction
INDIRECT renvoie la valeur d'erreur #REF!.
Bref, ce n'est pas possible. La fonction INDIRECT ne marche pas si le classeur dans lequel on
souhaite lire des données n'est pas ouvert.
Pour pallier au problème, la fonction personnalisée suivante permet d'effectuer cette lecture :
Vba |
Function LireCellule_ClasseurFerme ( _
Chemin As String , _
Fichier As String , _
Feuille As String , _
Cellule As Variant) As Variant
Application. Volatile
Dim Source As Object, Rst As Object, ADOCommand As Object
Dim Cible As String
Feuille = Feuille & " $ "
Cible = Cellule. Address (0 , 0 , xlA1, 0 ) & " : " & _
Cellule. Address (0 , 0 , xlA1, 0 )
Set Source = CreateObject (" ADODB.Connection " )
Source. Open " Provider=Microsoft.Jet.OLEDB.4.0; " & _
" Data Source= " & Chemin & " \ " & Fichier & _
" ;Extended Properties= " " Excel 8.0;HDR=No; " " ; "
Set ADOCommand = CreateObject (" ADODB.Command " )
With ADOCommand
. ActiveConnection = Source
. CommandText = " SELECT * FROM [ " & Feuille & Cible & " ] "
End With
Set Rst = CreateObject (" ADODB.Recordset " )
Rst. Open ADOCommand, , 1 , 3
Set Rst = Source. Execute (" [ " & Feuille & Cible & " ] " )
LireCellule_ClasseurFerme = Rst (0 ). Value
Rst. Close
Source. Close
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
End Function
|
Vous pouvez ensuite insérer ce type de formule dans une cellule :
=LireCellule_ClasseurFerme(A1;A2;A3;G7)
A1 correspond au chemin:
C:\Documents and Settings\mimi\dossier
A2 correspond au nom du classeur:
ClasseurY.xls
A3 correspond au nom de la feuille:
Feuil1
G7 correspond à la cellule qui doit être lue dans le classeur fermé.
|
| auteur : Cafeine |
Cette fonction nécessite d'activer la référence DAO.
Vba |
Option Explicit
Public Function XRECHERCHEV (ByVal valRecherchee As Variant, _
ByVal TabMatrice As Variant, _
ByVal colonneIndex As Integer)
If TypeName (TabMatrice) = " Range " Then
XRECHERCHEV = Application. WorksheetFunction . VLookup (valRecherchee, _
TabMatrice, _
colonneIndex, _
True )
Else
Dim db As DAO. Database
Dim rs As DAO. Recordset
Dim sRange As String
Dim sSheet As String
Dim sWbook As String
Dim sFPath As String
Dim sSQL As String
sRange = Replace (Split (TabMatrice, " ! " )(1 ), " $ " , vbNullString )
sSheet = Split (Split (TabMatrice, " ] " )(1 ), " ' " )(0 )
sWbook = Split (Split (TabMatrice, " [ " )(1 ), " ] " )(0 )
sFPath = Mid (Split (TabMatrice, " [ " )(0 ), 2 )
valRecherchee = " ' " & Replace (valRecherchee, " ' " , " '' " ) & " ' "
sSQL = " SELECT [F " & colonneIndex & " ] " & _
" FROM [ " & sSheet & " $ " & sRange & " ] " & _
" WHERE [F1] = " & valRecherchee
Set db = DAO. OpenDatabase (sFPath & sWbook, False , False , " Excel 8.0;HDR=NO; " )
Set rs = db. OpenRecordset (sSQL, DAO. dbOpenSnapshot )
If rs. EOF And rs. BOF Then
XRECHERCHEV = " no match "
Else
XRECHERCHEV = rs. Fields (0 )
End If
Set rs = Nothing
Set db = Nothing
End If
End Function
|
Un exemple d'utilisation dans la feuille de calcul:
Formule |
= XRECHERCHEV (A2;" 'C:\Perso\[ " & D2 & " ]_Synthèse'!$A$2:$F$35 " ;6 )
|
|
| auteur : Cafeine |
Utilisez cette fonction personnelle.
Les avantages :
* Les caractères génériques sont supportés.
* Concaténation de résultats multiples.
* La colonne récupérée n'appartenant pas au tableau "matrice" peut même être située avant le tableau.
Inconvénient :
* Plus lente que la fonction native RECHERCHEV / VLOOKUP.
Exemple d'utilisation:
=ConcatVLookUp("Frédéri*";A1:A500;2;VRAI;" - ")
La fonction ramène la deuxième colonne pour les Frédéric et Frédérique en concaténant les valeurs
avec " - " comme séparateur.
Vba |
Function ConcatVLookUp (ByVal ValRecherche, _
ByVal TabMatrice As Range, _
ByVal IndexCol, _
Optional ByVal blnConcat As Boolean = False , _
Optional ByVal Separateur = " ; " ) As Variant
Dim c As Range
application. Volatile
For Each c In TabMatrice. Cells
If c. Value Like ValRecherche Then
ConcatVLookUp = ConcatVLookUp & Separateur & c. Offset (0 , IndexCol - 1 ). Value
If Not blnConcat Then Exit For
End If
Next c
ConcatVLookUp = Mid (ConcatVLookUp, Len (Separateur) + 1 )
Set c = Nothing
End Function
|
|
| auteur : Bidou |
Le problème ne vient pas de la recherche mais de l'appel d'une propriété / méthode sur l'objet renvoyé.
Je prends un exemple standard produit par l'enregistreur de macro.
Vba |
Range (" A2:C21 " ). Select
Selection. Find (What:= " 170 " , After:= ActiveCell, LookIn:= xlValues, LookAt _
:= xlPart, SearchOrder:= xlByRows, SearchDirection:= xlNext, MatchCase:= _
False ). Activate
|
Ce code fonctionnera sans problème pour peu que la valeur cherchée existe dans la plage. En effet la méthode Find
renvoie un objet Range désignant la cellule contenant la valeur ou Nothing si celle-ci n'existe pas. Dans le cas
de ce code elle va donc tenter de faire Nothing.Activate d'où l'erreur. Pour utiliser correctement la recherche,
utilisez le type de code suivant :
Vba |
Dim objCell As Range, PremAdresse As String , PlageResult As Range
With Range (" A2:C21 " )
Set objCell = . Find (What:= " 170 " , After:= ActiveCell, LookIn:= xlValues, LookAt:= xlPart, SearchOrder:= xlByRows, SearchDirection:= xlNext)
If Not objCell Is Nothing Then
PremAdresse = objCell. Address
Do
If PlageResult Is Nothing Then
Set PlageResult = objCell
Else
Set PlageResult = Application. Union (objCell, PlageResult)
End If
Set objCell = . FindNext (objCell)
Loop While Not objCell Is Nothing And objCell. Address < > PremAdresse
End If
End With
|
L'objet plageResult contiendra toutes les cellules contenant la valeur, ou Nothing si cette valeur n'existe pas.
|
| auteur : SilkyRoad |
Utilisez l'évènement Workbook_Open qui est
déclenché à l'ouverture du fichier.
Dans cet exemple, les dates sont dans la colonne A de la Feuil1.
Vba |
Private Sub Workbook_Open ()
With Worksheets (" Feuil1 " )
. Activate
. Columns (1 ). Find (Date ). Select
End With
End Sub
|
|
| auteur : Bidou |
Comme je l'ai dit dans une autre réponse, il faut éviter les longues énumérations. Supposons que je veuille trouver
toutes les cellules ayant un fond bleu.
Vba |
For Each objCell In ThisWorkbook. Worksheets (1 ). Cells
If objCell. Interior . ColorIndex = 5 Then
If objRange Is Nothing Then
Set objRange = objCell
Else
Set objRange = Application. Union (objCell, objRange)
End If
End If
Next
|
Ce code est facile à écrire mais très long à exécuter. Pour accélérer la méthode je vais utiliser le regroupement des propriétés.
Dans Excel, lorsqu'une propriété est équivalente pour toutes les cellules d'une plage, elle est renvoyée comme propriété de
la plage, sinon c'est Null qui est renvoyé. Dès lors je vais parcourir les colonnes et ne garder que celles contenant au moins
une cellule ciblée. Puis je ferais le parcours des lignes de la même façon. Par intersection, il sera facile de composer ma plage
de retour.
Vba |
Dim objRange As Range, PlageRed As Range, objCell As Range, PlageResult As Range
For Each objRange In ThisWorkbook. Worksheets (1 ). Columns
If IsNull (objRange. Interior . ColorIndex ) Then
If PlageRed Is Nothing Then
Set PlageRed = objRange
Else
Set PlageRed = Application. Union (objRange, PlageRed)
End If
End If
Next
For Each objRange In ThisWorkbook. Worksheets (1 ). Rows
If IsNull (objRange. Interior . ColorIndex ) Then
For Each objCell In Application. Intersect (objRange, PlageRed). Cells
If objCell. Interior . ColorIndex = 5 Then
If PlageResult Is Nothing Then
Set PlageResult = objCell
Else
Set PlageResult = Application. Union (objCell, PlageResult)
End If
End If
Next
End If
Next
PlageResult. Select
|
|
| auteur : SilkyRoad | Vba |
Dim Repertoire As String , Fichier As String
Dim Wb As Workbook
Dim Ws As Worksheet
Dim i As Integer
Application. ScreenUpdating = False
Set Ws = ThisWorkbook. Worksheets (1 )
Repertoire = " C:\Documents and Settings\mimi\dossier\ "
Fichier = Dir (Repertoire & " *.xls " )
Do While Fichier < > " "
If ThisWorkbook. Name < > Fichier Then
Set Wb = Workbooks. Open (Repertoire & Fichier)
i = i + 1
Ws. Cells (i, 1 ) = Wb. Worksheets (1 ). Range (" A1 " )
Ws. Cells (i, 2 ) = Fichier
Wb. Close False
End If
Fichier = Dir
Loop
Application. ScreenUpdating = True
MsgBox " Terminé "
|
|
Consultez les autres F.A.Q's
Les sources présentés sur cette pages sont libre de droits,
et vous pouvez les utiliser à votre convenance. Par contre cette page de présentation de ces sources constitue une oeuvre intellectuelle protégée par les droits d'auteurs.
Copyright ©2008
Developpez LLC. Tout droits réservés Developpez LLC.
Aucune reproduction, même partielle, ne peut être faite de ce site et de
l'ensemble de son contenu : textes, documents et images sans l'autorisation
expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à 3 ans
de prison et jusqu'à 300 000 E de dommages et intérets.
Cette page est déposée à la SACD.
|