Modification de macro pour récupération de cellules

flosauveur69

XLDnaute Occasionnel
Bonjour à tous,

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

Do Until ActiveCell = ""
If ActiveCell.Value = "Date: " Then
Date_reportee = ActiveCell.Offset(0, 1).Value
Sheets("Feuil2").Select
DerLig = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row
Range("D" & DerLig + 1).Select
ActiveCell = Date_reportee
Else
If ActiveCell.Value = "Code" Then
Code_reportee = ActiveCell.Offset(0, 1).Value
Sheets("Feuil2").Select
DerLig = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Range("A" & DerLig + 1).Select
ActiveCell = Code_reportee
Else
If ActiveCell.Value = "Serial Number: " Then
Serial_reportee = ActiveCell.Offset(0, 1).Value
Sheets("Feuil2").Select
DerLig = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Range("B" & DerLig + 1).Select
ActiveCell = Serial_reportee
Else
If ActiveCell.Value = "UUT Result: " Then
Resultat_reportee = ActiveCell.Offset(0, 1).Value
Sheets("Feuil2").Select
DerLig = ActiveSheet.Range("I" & Rows.Count).End(xlUp).Row
Range("I" & DerLig + 1).Select
ActiveCell = Resultat_reportee
Else
If ActiveCell.Value = "Time: " Then
Time_reportee = ActiveCell.Offset(0, 1).Value
Sheets("Feuil2").Select
DerLig = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
Range("E" & DerLig + 1).Select
ActiveCell = Time_reportee
Else
If ActiveCell.Value = "Execution Time: " Then
Execution_reportee = ActiveCell.Offset(0, 1).Value
Sheets("Feuil2").Select
DerLig = ActiveSheet.Range("G" & Rows.Count).End(xlUp).Row
Range("G" & DerLig + 1).Select
ActiveCell = Execution_reportee

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

Sheets("Feuil1").Select
ActiveCell.Offset(1, 0).Select
Loop

End Sub
 

Pièces jointes

  • Passed_TRVP066187000_1030_B_000.xls
    35.5 KB · Affichages: 48

YANN-56

XLDnaute Barbatruc
Re : Modification de macro pour récupération de cellules

Bonjour flosauveur, Staple, et à ceux qui passeront par ici,

Voici accessoirement une réponse à l'une de tes récentes questions.

J'aimerais, si possible, que la macro me récupère et me colle cette plage
de cellule sans ouvrir puis fermer les classeurs dans le but de gagner du temps.

Regarde du coté de la méthode ADO, tu auras certainement une bonne solution!

D'un autre coté, à trop jouer les "Pique-assiette"; tu ne vas pas avancer...
(J'ai bon souvenir d'autres Post)

Ou alors, tu rédiges un cahier des charges complet, et tu trouveras
peut-être quelqu'un disposé à te livrer une appli clé en main. :D

Amicalement.

Yann
 

job75

XLDnaute Barbatruc
Re : Modification de macro pour récupération de cellules

Bonjour le fil,

La macro présentée par notre ami il l'a copiée je ne sais où.

Je la connais car c'est moi qui l'ai aidé à la modifier (le début uniquement, les Select etc... c'est de son cru).

Ce qui me sidère c'est que sur un autre fil il cherchait à l'accélérer sans ouvrir les fichiers (comme le rappelle Yann) et que maintenant il é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: "

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

Avec une recherche de mots sur tous les fichiers, ça ne va pas être triste en terme de rapidité :rolleyes:

A+
 
Dernière édition:

YANN-56

XLDnaute Barbatruc
Re : Modification de macro pour récupération de cellules

Re à tous, Bonjour job75,

J'ai une idée:

1) De lui suggérer de donner à tous les Classeurs où il fouille, une même structure!!!
2) Qu'il travaille à ce qu'il est possible de faire avec: "Application.ExecuteExcel4Macro" et "ADO"
3) De rebaptiser toutes les variables des codes pompés avec des Noms Explicites pour mieux comprendre.
4) De partager sa rémunération au prorata de ce qui est fait dans le cadre de ses heures de boulot.

Pendant ce temps, on va y gagner à l'actualisation de la page d'accueil du Forum! :)

Amicalement.

Yann
 

flosauveur69

XLDnaute Occasionnel
Re : Modification de macro pour récupération de cellules

Re à tous,

alors plusieurs petites infos, je cherche tout d'abord à prendre dans mes fichiers excel les données cités ci-dessus. Et dans la mesure du possible accélérer cette macro.

Ensuite:
-Pour ce qui est des classeurs où je "fouille", ils sont sur le réseau et générer automatiquement donc non modifiable
-La plupart des variables, je les ai nommé moi même mais en effet je peux les rendre plus explicite
-Pour ce qui est de la rémunération, euh étant stagiaire (en école d'ingé) dans une très petite boite (sans beaucoup de moyens), je veux bien le diviser, mais ça ferait une bulle ^^
-D'après vos dires, il faudrait que je me tourne vers les méthodes "Application.ExecuteExcel4Macro" et "ADO" , ce que je vais faire mais étant bleu la dedans, vos aides seraient les bienvenues.

Bien cordialement.
 

Discussions similaires

Réponses
7
Affichages
328

Membres actuellement en ligne

Statistiques des forums

Discussions
312 247
Messages
2 086 591
Membres
103 248
dernier inscrit
Happycat