Recherche de contrats

**laminosd** · 17/10/2014, 14h55

Bonjour tout le monde,

je veux développé une macro qui va aller chercher dans un répertoire qui contient plusieurs fichiers Excel le numéro de contrat tapé dans la cellule A1 par exemple,s'il trouve le contrat dans le premier fichier il m'affiche OK sinon KO ainsi de suite jusqu'à la fin.

Merci pour votre aide

Pour l'instant j'ai réussi à compter le nombre de ligne de la première feuille de chaque classeur voici mon code

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
Sub Ouvrir_Fichiers()
' Permet d'ouvrir plusieurs fichiers dans un répertoire
' GC Excel - 2011-11-16
 
Dim wb As Workbook, wb2 As Workbook
Dim sPath As String, sFilename As String
Dim NbRows As Integer, rg As Range
 
Set wb = ThisWorkbook
 
Application.ScreenUpdating = False
 
sPath = "E:\lamine\test\"       'Répertoire
sFilename = Dir(sPath & "*.xls*")        'ouvre tous les fichiers .xls*
 
Do While Len(sFilename) > 0
Set wb2 = Workbooks.Open(sPath & sFilename)           'Ouvre le fichier
'
' Votre code ici
 
 
    NbRows = wb2.Sheets(1).Range("A60000").End(xlUp).Row  'Nb de lignes
Set rg = wb.Sheets(1).Range("A60000").End(xlUp).Offset(1, 0)
    rg = sFilename
    rg.Offset(0, 1) = NbRows
 
 
'
'
    wb2.Close False   'Fermer le fichier
    sFilename = Dir
 
Loop
Application.ScreenUpdating = True
 
End Sub

**parmi** · 17/10/2014, 17h39

Bonjour,

Tu dis que le numéro de contrat est en A1 (par exemple...).
Est-ce qu'il y est ou tu as besoin de boucler les lignes pour le trouver ?
Autrement, je ne vois pas la nécessité de savoir le nombre de lignes des fichiers que tu ouvres...

**QuestVba** · 17/10/2014, 21h13

Bonsoir,

tu pourrais voir ceci

**laminosd** · 20/10/2014, 15h32

Envoyé par parmi

Bonjour,

Tu dis que le numéro de contrat est en A1 (par exemple...).
Est-ce qu'il y est ou tu as besoin de boucler les lignes pour le trouver ?
Autrement, je ne vois pas la nécessité de savoir le nombre de lignes des fichiers que tu ouvres...

Bonjour,

je veux en tapant le numéro de contrat dans une cellule quelconque ,que la macro cherche dans tous les fichiers du répertoire et m'afficher ok s'il le trouve sinon ko l'objectif c'est de trouver ou se trouve le contrat dans quel fichier le nombre de ligne ne sert à rien c’était juste un exemple merci pour ta réponse.

**parmi** · 20/10/2014, 16h10

À quel endroit peut se retrouver ce numéro de contrat ?
Est-ce une ligne ou colonne fixe ? ou ça peut être n'importe où ?

**keygen08** · 20/10/2014, 16h18

Bonjour
Ce code boucle sur tous les classeurs Excel d'un répertoire et en extrait le contenu de la cellule A1 Feuil1, en l'occurence pour l'exemple, une date, sans ouvrir le classeur

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
Sub ImporterDates()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
If objFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
    Columns(1).NumberFormat = "m/d/yyyy"
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
    [B1] = Chemin
    fichier = Dir(Chemin & "*.xls")
    Do While Len(fichier) > 0
        If fichier <> ThisWorkbook.Name Then
            ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$1"
            With Sheets("Feuil2")
                .[A1] = "=Plage"
                .[A1].Copy
                Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = fichier
            End With
        End If
        fichier = Dir()
    Loop
End If
End Sub

**laminosd** · 20/10/2014, 17h33

Envoyé par parmi

À quel endroit peut se retrouver ce numéro de contrat ?
Est-ce une ligne ou colonne fixe ? ou ça peut être n'importe où ?

c'est une colonne fixe ( la colonne B) de tous les classeurs .

**laminosd** · 20/10/2014, 17h37

Envoyé par keygen08

Bonjour
Ce code boucle sur tous les classeurs Excel d'un répertoire et en extrait le contenu de la cellule A1 Feuil1, en l'occurence pour l'exemple, une date, sans ouvrir le classeur

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
Sub ImporterDates()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
If objFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
    Columns(1).NumberFormat = "m/d/yyyy"
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
    [B1] = Chemin
    fichier = Dir(Chemin & "*.xls")
    Do While Len(fichier) > 0
        If fichier <> ThisWorkbook.Name Then
            ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$1"
            With Sheets("Feuil2")
                .[A1] = "=Plage"
                .[A1].Copy
                Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = fichier
            End With
        End If
        fichier = Dir()
    Loop
End If
End Sub

Merci pour ta réponse je cherche à faire une macro qui cherche un numéro de contrat dans des fichiers trouvant dans un répertoire ,on retrouve le numéro de contrat dans la colonne B de tous les classeurs

**parmi** · 20/10/2014, 17h46

En partant de ce que tu avais commencé, ça devrait ressembler à 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
Sub Ouvrir_Fichiers()
' Permet d'ouvrir plusieurs fichiers dans un répertoire
' GC Excel - 2011-11-16
 
Dim wb As Workbook, wb2 As Workbook
Dim sPath As String, sFilename As String
Dim NbRows As Integer, rg As Range
Dim Recherche as Range
Dim Code
Dim Trouve as Boolean
 
Set wb = ThisWorkbook
 
Application.ScreenUpdating = False
 
sPath = "E:\lamine\test\"       'Répertoire
sFilename = Dir(sPath & "*.xls*")        'ouvre tous les fichiers .xls*
 
Code = wb.Sheets(1).Range("A1") '<<< changer le A1 pour la cellule où se trouve le contrat à rechercher
 
Do While Len(sFilename) > 0
Set wb2 = Workbooks.Open(sPath & sFilename)           'Ouvre le fichier
'
' Votre code ici
   Set Recherche = wb2.Sheets(1).Columns("B").Find(Code, LookIn:=xlValues, LookAt:=xlWhole)
   If Not Recherche Is Nothing Then  'trouvé
      Trouve = True
   end if
 
'    NbRows = wb2.Sheets(1).Range("A60000").End(xlUp).Row  'Nb de lignes
Set rg = wb.Sheets(1).Range("A60000").End(xlUp).Offset(1, 0)
    rg = sFilename
    rg.Offset(0, 1) = NbRows
    If Trouve Then
       rg.Offset(0, 2) = "OK"
    else
       rg.Offset(0, 2) = "KO"
    end if
 
    wb2.Close False   'Fermer le fichier
    sFilename = Dir
 
Loop
Application.ScreenUpdating = True
 
End Sub

**laminosd** · 22/10/2014, 09h28

Bonjour tu m’excuse du dérangement je reviens vers toi car j'ai testé ma macro mais elle marche à moitié je t'explique:
j'ai remarqué en exécutant ma macro si je met par exemple le numéro du contrat dans le premier fichier il me le trouve correctement le fichier en m'affichant OK et le reste KO par contre si je le met le contrat dans le troisième fichier et qu'il reste deux fichiers en dessous du troisième elle m'affiche OK pour tous le reste de fichiers c'est à dire

fichier1 KO
fichier2 KO
fichier3 (ici se trouve le contrat ) OK
fichier4 OK
fichier5 OK
fichier6 OK

ET POURTANT DANS LES FICHIERS 4 5 6 le contrat n'existe pas

Merci d'avance

**laminosd** · 22/10/2014, 11h35

j'ai trouvé la solution il fallait juste écrire trouve=false avant de faire la recherche

Code :

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

1
2
3
4
5
6
Trouve = False
 
   Set Recherche = wb2.Sheets(1).Columns("A").Find(Code, LookIn:=xlValues, LookAt:=xlWhole)
   If Not Recherche Is Nothing Then  'trouvé
      Trouve = True
   End If

merci bcp

**parmi** · 22/10/2014, 11h43

Bien vu....

Recherche de contrats

Macros et VBA Excel

Discussions similaires

Partager

Partager