Ouvrir plusieurs fichiers excel et effectuer une recherche

**benzot** · 10/06/2015, 12h43

Bonjour,

Je souhaiterais pouvoir récupérer des données précises dans plusieurs fichiers excel (fiches) et ensuite les classer dans un nouveau tableau (recap données).

Pour faire cela, je souhaiterais effectuer cette importation via un bouton présent dans le tableau de données

Je joints 2 fichiers exemple, le top, serai de récupérer les infos pour les COL1 a COL5 et de les incrémenter dans le tableau de données

-la fusion des cellules est identique entrent les 2 fichiers
-la recherche est toujours entre les mêmes lignes 21 à 41 sur le fichier fiche

J'ai mis un début de code dans le tableau de donnée.

Merci D'avance, pour le coup de main

**Fanfan2A** · 10/06/2015, 13h38

Bonjour,

Tout d'abord il faudrait que toutes les fiches soient dans un même fichier (fichier "Fiches" avec onglets Fiche1, Fiche2, Fiche3, etc...).
Dans le cas contraire, il faudrait connaitre le nommage des fichiers et leur emplacement afin de pouvoir les ouvrir successivement.

Ensuite vous dites que " le top, serai de récupérer les infos pour les COL1 a COL5 et de les incrémenter dans le tableau de données" ???
Je pense que vous vouliez dire de répartir les infos ...

Enfin, si j'ai bien deviné ce que vous souhaitez, la répartition doit s'effectuer via la clé COL1 qui va donc permettre d'écrire les données lues sur la fiche dans le tableau correspondant au stade (1, 2 ou 3). Alors pourquoi écrire à nouveau la valeur de COL1 dans le tableau ?

Le mieux serait de mettre un peu plus d'infos avec le résultat escompté...

Cordialement.

**benzot** · 10/06/2015, 14h21

Bonjour Fanfan,

Pour les fichiers, ce n'est pas possible de les avoirs tous dans un même fichier, par contre les noms des fichiers se suivent bien : Fiche 1, fiche 2 etc... et le dossier de stockage est en local sur mon PC (c:\Fiches\).

Effectivement, j'ai mal interprété mon souhait, je reprend mon explication.

Je voudrais si cela est possible qu'à l'ouverture d'une fiche (ex :fiche1, ouvert via le tableau de donnée) que par exemple, le mot "FOOT" soit détecté entre B21 à B41 et que si celui-ci est trouvé 1 fois ou plusieurs fois que les COL1 à 5 de cette même ligne soient reportées dans le tableau de donnée (dans la partie stade 1 par exemple) si rien n'est détecter il passe à l'autre fichier etc..(bien sur aucune modification sur les fiches).

stade2, stade 3 du tableau ça sera pour un autre mot à détecter.

Cordialement

**Fanfan2A** · 10/06/2015, 14h47

Lorsqu'une fiche sera ouverte en lecture, il faut savoir précisément ce qui va permettre de copier les valeurs lues dans la partie "Stade 1" ou "Stade 2" ou "Stade 3" du tableau !

Pourriez-vous, S.V.P., remplir 1 ou 2 fiches avec 6 ou 7 lignes ainsi que le tableau résultat attendu ?
Cela simplifierai les choses !

**benzot** · 10/06/2015, 22h00

Hello,

J'ai ajouter quelques données et mis à jour les 2 fichiers joint dans le 1er message.

Exactement, c'est d'avoir un bouton (par exemple IMPORTATION) et lors de l'appui sur celui-ci, cela ouvre les fiches et recherche dans le tableau de la fiche entre B21:B41 les termes FOOT, puis pour TENNIS ETC...

Si chaque terme est présent 1 ou plusieurs fois, on copie la ou les lignes correspondantes mais que les colonne J à Q, dans le tableau de données

Est ce que ce code peut faire l'affaire pour l'ouverture des fichiers ?

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
Option Explicit
 
Private Sub import_Click()
' Ouvre tous les fichiers excel contenus dans un répertoire.
'
Dim Système As Object           'Système de fichiers
Dim Dossier As Object           'Répertoire
Dim Fichiers As Object          'Collection de fichiers du répertoire
Dim Fichier As Object           'Fichier (élément de la collection Fichiers)
Dim Nom_Dossier As String       'Nom du répertoire
Dim Nom_Fichier As String       'Nom du fichier
Dim SPORTS As Range
Dim trouve_SPORTS As Range
Dim i As Long
 
 
'Lecture du répertoire
Nom_Dossier = "C:\FICHES\"
Set Système = CreateObject("Scripting.FileSystemObject")
Set Dossier = Système.GetFolder(Nom_Dossier)
Set Fichiers = Dossier.Files
'Contrôler chaque fichier du répertoire
For Each Fichier In Fichiers
  '- Vérifier s'il s'agit d'un fichier Excel...
  If StrComp(Système.GetExtensionName(Fichier.Name), "xls", vbTextCompare) = 0 Then
    '... dans l'affirmative, ouvrir le fichier et mettre à jour les liaisons
    Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
    Workbooks.Open Filename:=Nom_Fichier
Application.ScreenUpdating = False
    With Sheets("FICHE 1")
For Each mission In Range([C4], [C4].End(xlDown))
    ''''''''''''
  End If
Next Fichier
Application.ScreenUpdating = True
End Sub

CDT

**patricktoulon** · 10/06/2015, 23h50

Bonsoir
dans excel tu a des outils il faudrait apprendre a s'en servir

je n'ai pas tester mais ca doit etre un truc du genre
a toi d'adapter !!!!

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
Sub test()
   application.screenupdating=false
   application.displayalerts=false 
 chemin = "C:\fiche\"
    nomfich = Dir(chemin & "*.xls")
    Do While nomfich <> ""
        If Left(nomfich, 5) = "fiche" Then
            Set wbkP = Workbooks.Open(chemin & nomfich)
            Set plage = Sheet(1).Range("A21:E41")                ' adapte l'index ou le nom du sheets
            Set c = plage.Find("foot", LookIn:=xlValues)
            If Not c = Nothing Then
                montablo = Range(Cells(c.Rows, 1), Cells(c.Row, 5))
                wbk.Close
               End If
              Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 5) = montablo
            End If
            nomfich = Dir()
        Loop
  End Sub

comme ca vite fait
c'est sensé boucler sur les fichier du dossier
prendre les fichier commençant par "fiche"
les ouvres
recherche le mot "foot" dans la plage A21:e41"
si il y est prend la ligne sur les 5 colonne
ferme la fiche et colle le résultat dans la première ligne vide du classeur de destination et passe au suivant

le tout sans Scripting et autre object FSO

EDIT j'avais oublié un "end if"

**benzot** · 11/06/2015, 09h45

Bonjour,

Ok Patrick, je vais tester votre code

merci

**Marc-L** · 11/06/2015, 20h38

Bonsoir !

Patrick, le plus direct serait la copie de données filtrées en 2/3 lignes de code …

_____________________________________________________________________________________________________
Je suis Charlie - Je suis Bardo

**benzot** · 11/06/2015, 22h44

J'ai testé le code, il fonctionne bien, je le remet avec quelques petites modifications (j'avais quelques erreurs)

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
Sub import()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
chemin = "C:\fiche\"
nomfich = Dir(chemin & "*.xls")
 
    Do While nomfich <> ""
       If Left(nomfich, 5) = "fiche" Then
            Set wbkP = Workbooks.Open(chemin & nomfich)
            Set plage = Worksheets("fiche01").Range("B36:E55")  ' ici j'avais une erreur avec sheet
            Set c = plage.Find("foot", LookIn:=xlValues)
            If Not c Is Nothing Then 'ici j'avais une erreur avec le =
montablo = Range(Cells(c.Row, 11), Cells(c.Row, 18)) ' ici avec le s
                ActiveWorkbook.Close ' ici avec wbk.close
               End If
Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Resize(1, 7) = montablo
            End If
            nomfich = Dir()
        Loop
  End Sub

cela fonctionne bien, ça analyse rapidement les fichiers

mais est ce que l'on peut effectuer plusieurs recherche avant de changer de fichier ?

merci

**patricktoulon** · 12/06/2015, 11h09

Envoyé par Marc-L

Bonsoir !

Patrick, le plus direct serait la copie de données filtrées en 2/3 lignes de code …

salut Marc oui tu a raison

bensot
ou la!!! oui ces petite erreurs c'est quand je tape le code directement dans le post et que je ne teste pas des fois je vais un peu vite c'est vrai
l'important c'est que tu en ai compris le fonctionnement

oui!! c'est possible

on peut répéter le find sur chaque argument avant de fermer en mémorisant dans des variable tableaux avant de fermer le classeur 2 puis transposer les tableaux dans le classeur de destination

cela devrait faire l'affaire ,ca va chercher les 3 indices dans chaque classeur du dossier
adapte bien sur le sheet !!!!!

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
Option Base 1
Sub import()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim indice, mestablos, i As Long, a As Long, plage As Range, chemin As String, wbkP As Workbook, nomfich
    indice = Array("foot", "tennis", "basket")
    ReDim mestablos(UBound(indice))
    chemin = "C:\fiche\"
    nomfich = Dir(chemin & "*.xls")
    Do While nomfich <> ""
        If Left(nomfich, 5) = "fiche" Then
            Set wbkP = Workbooks.Open(chemin & nomfich)
            Set plage = Worksheets("fiche01").Range("B36:E55")
            For i = 1 To UBound(indice)
                Set c = plage.Find(indice(i), LookIn:=xlValues)
                If Not c Is Nothing Then
                    mestablos(i) = Range(Cells(c.Row, 11), Cells(c.Row, 18))
                End If
            Next
           End If
           wbkP.Close    ' ici avec wbk.close ' c'est wbkP!!!!
            For a = 1 To UBound(mestablos)
                Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Resize(1, 7) = mestablos(i)
            Next
 
        nomfich = Dir()
    Loop
End Sub

**benzot** · 23/06/2015, 10h37

Bonjour Patrick,

J'ai essayé de l'adapté mais j'obtiens l'erreur suivante exécution 9, indice n'appartient pas à la sélection

Code :

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

Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Resize(1, 7) = mestablos(i)

Pour le code, il fait une recherche sur plusieurs termes. mais est ce qu'il copie l'ensemble sur le même tableau de destination ou au peu déterminer un tableau de destination pour chaque résultat de recherche?

Je suis bloqué sur cette erreur d'exécution 9, indice n'appartient pas à la sélection

merci encore pour le taff

Cordialement,

**Marc-L** · 23/06/2015, 13h53

Bonjour,

vérifier la valeur de la variable i, certainement en dehors des bornes de la variable tableau …
Et puis rien qu'en regardant le nom de la variable de la ligne précédente, à la portée d'un grand débutant ‼

_____________________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

**benzot** · 23/06/2015, 23h04

Bonjour Marc,

Oui tout à fait l'erreur est bien sur (i) mais j'arrive pas à cerner le problème, j'ai lu des explications sur l'utilisation des variables de tableaux, mais toujours le même soucis.

voila ce que le code m'indique :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
       For i = 1 To UBound(indice) 'm'indique = 23
            Set c = plage.Find(indice(i), LookIn:=xlValues) 'm'indique indice n'appartient pas à la sélection et i =24
        If Not c Is Nothing Then
mestablos(i) = Range(Cells(c.Row, 11), Cells(c.Row, 18))  'm'indique mestablos n'appartient pas à la sélection et i =24
        End If
            Next
        End If
            wbkP.Close
            
            For a = 1 To UBound(mestablos) 'm'indique = 23
Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Resize(1, 7) = mestablos(i)  'm'indique mestablos n'appartient pas à la sélection et i =24
        Next

j'ai mis 23 indices pour le moment

en supprimant le (i) a la fin,la macro se lance sans erreur mais rien ne se copie dans le fichier de destination.

Cdt, merci encore pour l'aide

un problème de déclaration de la variable ?

**Marc-L** · 24/06/2015, 00h26

i = 24 et a vaut quoi ?

Pourquoi en ligne précédente c'est la variable a qui est initialisée ?

La logique ?

**benzot** · 24/06/2015, 23h20

Bonjour,

Ah bah vu comme ça, je suis

de ne pas avoir pensé à cela.
pourtant, j'ai tourné un moment sur cette erreur, encore merci Marc pour m'avoir aiguillé

Cette macro du coup fonctionne bien pour la recherche des éléments prédéfini mais elle me copie un seul critère des éléments prédéfini dans le tableau de chaque fiche.

Peut-on ajouter à celle-ci, la possibilité de copier également tout les résultats identiques ?

CDT

**patricktoulon** · 24/06/2015, 23h27

SALUT
Find next !!!

**benzot** · 01/07/2015, 00h07

Bonsoir,

Ou positionner le findnext ?

Est ce que c'est bien ce code à ajouter ?

Code :

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

Set c = plage.FindNext(c)

Une boucle est nécessaire ?

Merci
Cdt

**benzot** · 05/07/2015, 20h50

Bonour,

Pouvez vous me dire ou le problème se pose, malgré ajout de findnext, cela me copie toujours un seul résultat.

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
Option Base 1
 
Sub import()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Dim plage As Range, chemin As String, wbkP As Workbook, nomfich, indice, mestablos, i, a, firstadress As String
 
indice = Array("foot", "basket", "tennis")
ReDim mestablos(UBound(indice))
 
chemin = "g:\Statistiques\sports\"
nomfich = Dir(chemin & "*.xls")
 
 
    Do While nomfich <> ""
    If Left(nomfich, 5) = "fiche" Then
            Set wbkP = Workbooks.Open(chemin & nomfich)
            Set plage = Worksheets("sports").Range("B35:e55")
            For i = 1 To UBound(indice)
            Set c = plage.Find(indice(i), LookIn:=xlValues)
            If Not c Is Nothing Then
firstadress = c.Address
        Do
Set c = plage.FindNext(c)
Loop While Not c Is Nothing And firstadress <> c.Address
mestablos(i) = Range(Cells(c.Row, 2), Cells(c.Row, 11))
  End If
         Next
            wbkP.Close
 
            For i = 1 To UBound(mestablos)
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 7) = mestablos(i)
        Next
            nomfich = Dir()
  End If
Loop
End Sub

CDT

Je n'ai toujours pas solutionné le positionnement du findnext, si vous avez un indice pour résoudre cette macro

Car soit ca me copie un seul indice de chaque, ou le loop est infini

Cdt

**patricktoulon** · 05/07/2015, 21h04

re

bon mille excuse je t'avais oublié .gros projet en ce moment!!

j'ai regardé ton dernier code
je ne suis pas étonné que ca marche pas !!!

quand tu ouvre une porte il y a une raison
1 tu veux entrer
2 tu veux voir ce qu'il y a dedans /dehors
3 tu fait entrer/sortir quelqu'un/QUELQUE CHOSE
ETC.... ETC .....

si tu teste un find et qu'il y a un firstadress il faut alimenter le "mestablos(X)

ilsuffisait de simplement placer l'alimentation des tablos au bon moment

erreur de débutants

pour le reste je ne peut pas tester n'ayant pas ton fichier

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
Option Base 1
Sub import()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim plage As Range, chemin As String, wbkP As Workbook, nomfich, indice, mestablos, i, a, firstadress As String
    indice = Array("foot", "basket", "tennis")
    ReDim mestablos(UBound(indice))
    chemin = "g:\Statistiques\sports\"
    nomfich = Dir(chemin & "*.xls")

    Do While nomfich <> ""
        If Left(nomfich, 5) = "fiche" Then
            Set wbkP = Workbooks.Open(chemin & nomfich)
            Set plage = Worksheets("sports").Range("B35:e55")
            For i = 1 To UBound(indice)
                Set c = plage.Find(indice(i), LookIn:=xlValues)
                If Not c Is Nothing Then
                    firstadress = c.Address
                    Do
                       mestablos(i) = Range(Cells(c.Row, 2), Cells(c.Row, 11))
                       Set c = plage.FindNext(c)
                    Loop While Not c Is Nothing And firstadress <> c.Address
                    
                End If
            Next
            wbkP.Close
            For i = 1 To UBound(mestablos)
                Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 7) = mestablos(i)
            Next
            nomfich = Dir()
        End If
    Loop
End Sub

**benzot** · 06/07/2015, 19h36

Merci patrick pour le suivi,

J'ai effectué la modification sur la macro (pas d'erreur) mais ca me copie seulement les premiers indices trouvés de chaque fichier.

Ceux en double, il en veux pas.

Dans le pas a pas, il cherche bien tout les indices. le i s'incremente bien.

Mais sur le tableau ou la copie s'effectue, il copie pas tout les resultats.

cdt.

Ouvrir plusieurs fichiers excel et effectuer une recherche

Macros et VBA Excel

Discussions similaires

Partager

Partager