Accueil
Accueil Le Club Delphi Kylix C C++ Java J2EE DotNET & C# Visual Basic Access Pascal Dev Web PHP ASP XML UML SQLSGBD Windows Linux Autres
logo

precedent    sommaire    suivant   


Comment utiliser la fonction RechercheV sur un classeur fermé ?
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)



Comment utiliser la fonction Indirect pour lire une cellule dans un classeur fermé ?
auteur : SilkyRoad
Dans le tableur Excel, il est possible de lire le contenu d'une cellule d'un classeur fermé par formule:

Formule

='C:\dossier\excel\[ClasseurBase.xls]Feuil1'!$A$1


Voire même d'y faire une recherche:

Formule

'Faire une RECHERCHE Verticale dans un classeur fermé:
'Rechercher "DVP" dans la colonne A du classeur fermé et 
'afficher la donnée correspondante de la colonne B.
=RECHERCHEV("DVP";'C:\dossier\excel\[ClasseurBase.xls]Feuil1'!$A:$B;2;FAUX)



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")
    '1 = adOpenKeyset, 3 = adLockOptimistic
    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é.



Comment réaliser des RECHERCHEV sur des classeurs fermés dont les chemin, feuille et plage sont variables ?
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)

Comment faire une RECHERCHEV avec caractères génériques et concaténation ?
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
                  
' Permet une recherchev sur des caractères génériques
'
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

Pourquoi ai-je une erreur lors d'une recherche si la valeur n'existe pas ?
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.



Comment atteindre la cellule qui contient la date du jour, lors de l'ouverture du classeur ?
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

Je veux retrouver toutes les cellules ayant un fond particulier, mais le code est très long, que faire ?
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

'réduction de la plage
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
'travail en ligne
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

Comment boucler sur tous les classeurs d'un répertoire pour récupérer le contenu d'une cellule ?
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
 
'Définit la Première feuille du classeur contenant cette macro
'(pour recevoir les donnée extraites dans les autres classeurs).
Set Ws = ThisWorkbook.Worksheets(1)
 
'Définit le répertoire de recherche
Repertoire = "C:\Documents and Settings\mimi\dossier\"
'Spécifie la recherche pour le fichiers .xls
Fichier = Dir(Repertoire & "*.xls")
 
'Boucle sur les fichiers du répertoire
Do While Fichier <> ""
    'Vérifie que le nom du classeur est différent du classeur
    'contenant cette macro (dans le cas ou il serait placé dans le même répertoire).
    If ThisWorkbook.Name <> Fichier Then
        'Ouvre chaque classeur
        Set Wb = Workbooks.Open(Repertoire & Fichier)
        
        i = i + 1
        'Récupère le contenu de la cellule A1 dans la 1ere feuille de chaque classeur.
        Ws.Cells(i, 1) = Wb.Worksheets(1).Range("A1")
        Ws.Cells(i, 2) = Fichier
        
        'Referme le classeur
        Wb.Close False
    End If
    
    Fichier = Dir
Loop
 
Application.ScreenUpdating = True
MsgBox "Terminé"


Si vous devez boucler sur de nombreux classeurs, consultez l'article afin d'extraire les données sans ouvrir les classeurs.



precedent    sommaire    suivant   

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.

Vos questions techniques : forum d'entraide Accueil - Publiez vos articles, tutoriels, cours et rejoignez-nous dans l'équipe de rédaction du club d'entraide des développeurs francophones. Nous contacter - Copyright 2000..2005 www.developpez.com