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, G265000").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
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, G265000").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