Amélioration macro de récupération de données

Le 08/10/2010 à 13:30

Bonjour à tous,

J'ai ce souci que je vous expose:

j'ai une macro qui me récupère; dans le repertoire où se situe le classeur contenant cette macro; une plage de cellules dans tous les fichiers html présents (j'ai changer seulement l'extension du fichier exemple pour le mettre sur le forum mais c'est normalement une fichier html); en ouvrant puis fermant chaque fichier. Ensuite une 2ème macro me récupère les données qui m'intéresse dans cette plage de cellules. Cependant j'ai des données qui ne sont pas dans cette plage de données et qui ne sont pas au même endroi selon les fichiers.

J'aimerais si possible, une macro qui me récupère, cette fois-ci pas la plage de cellules voulue mais directement les cellules contenant (car il y a d'autres caractères dans la cellules) : "Product ID : "; "Serial Number: " ; "Time: "; "UUT Results: "; "Execution Time: "

Puis qu'elle me mette sur la même ligne les données récupérés de chaque fichiers.

Je vous met un exemple de fichiers dans lequel je veux récupérer ces données et les macro ci dessous.

Merci grandement de votre aide.

macro1:

Public Sub cmdRecupere_Click()
Dim strWB As String, strFile As String

Application.ScreenUpdating = False
Application.EnableEvents = False

' Nom du classeur actuel
strWB = ThisWorkbook.Name

' Récupération du premier fichier dans le répertoire et sous repertoire
strFile = Dir(ThisWorkbook.Path & "\*.html")

' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls" et si son nom n'existe pas en colonne C
If strFile <> strWB And Worksheets("Feuil1").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile

' Copie des données
Workbooks(strFile).Worksheets(1).Range("A21:C35").Copy
With Workbooks(strWB).Worksheets("Feuil1")
.Range("A2").Insert xlDown 'insertion en ligne 2
.Range("C2:C16").ClearContents 'on ne garde que les données A2:B17
.Range("C2") = strFile
End With

' Fermeture du classeur
Workbooks(strFile).Close
End If

' Classeur suivant
strFile = Dir
Loop

Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."
End Sub
macro2: 
Option Explicit

Sub Recherche_dates()

Dim Date_reportee As String, Code_reportee As String, Serial_reportee As String, Resultat_reportee As String, Time_reportee As Date, Execution_reportee As Date, DerLig As Integer, DerLig_F1 As Integer, i As Long

Application.ScreenUpdating = False

' suppression des lignes vides
Sheets("Feuil1").Select
DerLig_F1 = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = DerLig_F1 - 1 To 1 Step -1
    Range("A" & i).Select
    If ActiveCell = "" Then
        ActiveCell.EntireRow.Delete
    End If
Next

Sheets("Feuil2").Select
Range("A2:A65000, B2:B65000, I2:H65000, D2:N65000, E2:O65000, G2:P65000").ClearContents

Sheets("Feuil1").Select
Range("A1").Select
DerLig_F1 = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To DerLig_F1
        If ActiveCell.Value = "Date: " Then
        Date_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("d" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("d" & DerLig + 1) = Date_reportee
    Else
        If ActiveCell.Value = "Code" Then
        Code_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("A" & DerLig + 1) = Code_reportee
    Else
        If ActiveCell.Value = "Serial Number: " Then
        Serial_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("B" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("B" & DerLig + 1) = Serial_reportee
    Else
        If ActiveCell.Value = "UUT Result: " Then
        Resultat_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("i" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("i" & DerLig + 1) = Resultat_reportee
    Else
        If ActiveCell.Value = "Time: " Then
        Time_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("e" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("e" & DerLig + 1) = Time_reportee
    Else
        If ActiveCell.Value = "Execution Time: " Then
        Execution_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("g" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("g" & DerLig + 1) = Execution_reportee

    End If
    End If
    End If
    End If
    End If
    End If

    ActiveCell.Offset(1, 0).Select
Next
End Sub
Le 08/10/2010 à 14:39

Salut Flo,

Sur un autre fil, je t'avais proposé ta macro 2 ci-dessus par petits morceaux. Je constate maintenant que tu l'utilises d'une manière erronée (il n'est par exemple pas utile, comme je te l'avais proposé tout d'abord, d'effacer les lignes vides).

Voici donc cette macro tel que tu devrais l'utiliser :

Sub Recherche_dates()

Dim Date_reportee As String, Code_reportee As String, Serial_reportee As String, Resultat_reportee As String, Time_reportee As Date, Execution_reportee As Date, DerLig As Integer, DerLig_F1 As Integer, i As Long

Application.ScreenUpdating = False

Worksheets("Feuil2").Range("A2:A65000, B2:B65000, H2:H65000, N2:N65000, O2:O65000, P2:P65000").ClearContents

Range("A1").Select
DerLig_F1 = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To DerLig_F1
        If ActiveCell.Value = "Date: " Then
        Date_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("N" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("N" & DerLig + 1) = Date_reportee
    Else
        If ActiveCell.Value = "Code" Then
        Code_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("A" & DerLig + 1) = Code_reportee
    Else
        If ActiveCell.Value = "Serial Number: " Then
        Serial_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("B" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("B" & DerLig + 1) = Serial_reportee
    Else
        If ActiveCell.Value = "UUT Result: " Then
        Resultat_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("H" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("H" & DerLig + 1) = Resultat_reportee
    Else
        If ActiveCell.Value = "Time: " Then
        Time_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("O" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("O" & DerLig + 1) = Time_reportee
    Else
        If ActiveCell.Value = "Execution Time: " Then
        Execution_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("P" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("P" & DerLig + 1) = Execution_reportee

    End If
    End If
    End If
    End If
    End If
    End If

    ActiveCell.Offset(1, 0).Select
Next

End Sub

Pour le reste, comme je te l'ai dit sur cet autre fil, je préfère ne plus m'en occuper.

Bonnes salutations.

EDIT -- 8 10 2010 3:06 pm --

Flo,

J'ai bien reçu ton message privé. Ok, je ne jette pas l'éponge, tel que je te l'avais dit sur le fil https://forum.excel-pratique.com/excel/recuperer-donnees-de-la-cellule-de-droite-t19113.html

Il faut absolument que tu puisses joindre le fichier sur lequel tu travailles maintenant. Si ça ne passe pas, après l'avoir zippé, avec les moyens mis à disposition sur ce Forum, essaie de le placer (non zippé si possible, sinon zippé) sur le site http://www.cjoint.com .

A te relire.

Le 11/10/2010 à 09:08

Salut Yvouille,

Merci d'avance pour ton aide, voici le lien :

Bien cordialement.

Le 11/10/2010 à 20:35

Salut Flo,

J'essaie de comprendre ton problème. Tu indiques :

flosauveur69 a écrit :

... Ensuite une 2ème macro me récupère les données qui m'intéresse dans cette plage de cellules. Cependant j'ai des données qui ne sont pas dans cette plage de données et qui ne sont pas au même endroit selon les fichiers.

Je considère donc que tu es content de tes deux premières macros (Boutons "Récupérer Rapport de test" et "Récupérer données") et que le problème se situe après ...
flosauveur69 a écrit :

... J'aimerais si possible, une macro qui me récupère, cette fois-ci pas la plage de cellules voulue mais directement les cellules contenant (car il y a d'autres caractères dans la cellules) : "Product ID : "; "Serial Number: " ; "Time: "; "UUT Results: "; "Execution Time: "

Est-ce que le dernier fichier que tu as fourni présente la situation à ce moment-là, à la suite de ces deux premières macros ?

Si non, peux-tu fournir un fichier dans ce sens ? Dans tous les cas, peux-tu indiquer d'une manière claire - si possible directement dans le fichier - quelles informations tu voudrais voir transposer à quels endroits ? Ou alors sois plus précis dans tes explications (Par exemple : "A la suite de la macro "Récupérer données", je voudrais en plus que les données xxxxxxx et yyyyy des cellules Z1000:Z1500 de la "Feuil1" soient reportées dans les cellules A1:A1001 de la feuille "Données").

Ou peut-être que je n'ai rien compris et que quelqu'un d'autre à une solution à proposer ?

A te (vous) relire

Le 12/10/2010 à 16:21
30classeur1.xls (14.00 Ko)

Salut Yvouille,

en fait les 2 macros me conviennent pour un 1er type de fichiers dans lesquels je récupère les infos.

Mais elle ne conviennent pas à un second type de fichier que j'ai. Il faudrait donc les modifier ou les remplacer.

Je vais donc exposer au plus clairement mon problème:

J'ai des fichiers dont le nombre augmente à chaque instant (je vous en met un en exemple) dans lesquels je voudrais récupèrer des cellules citès après. Ces cellules ne se situent pas toujours au même endroi dans les différents fichiers et certaines sont à la fin du fichier dont la taille varie.

Je vous met un exemple de ce à quoi je voudrais que mon fichier "mère" ressemble, j'ai mis seulement la ligne de données correspondant au fichier en pièces jointes.

En gros, j'aimerais que la macro, me récupère les données de chaque fichiers excel du même répertoire que le fichier mère. Ces données sont en fait les cellules contenant:

Et qu'ils me les mettent en ligne pour chaque fichiers.

Merci grandement de votre aide

Le 12/10/2010 à 20:38

Salut Flo,

J'ai essayé de comprendre la suite de ton problème, mais je n'y arrive vraiment plus !

Tout d'abord, il est impossible d'ouvrir l'un de tes fichiers sans recevoir ce message :

capture flosauveur1

et tes autres indications ne me permettent pas d'aller de l'avant ; je te promets pourtant que ce n'est pas faute d'avoir essayé.

Alors soit tu obtiens de l'aide d'un autre membre d'ici peu, soit je te conseille de repartir avec un nouveau fil. Je te jures alors que je n'y interviendrais d'aucune manière. Désolé si je t'ai fait perdre du temps

Bonne continuation.

Le 18/10/2010 à 14:19

Salut Yvouille,

c'est moi qui te remercie pour toute l'aide que tu m'as apporté, je vais essayé d'avancer un peu sur le problème pour ensuite expliquer au mieu celui-ci.

Cordialement.

Rechercher des sujets similaires à "amelioration macro recuperation donnees"