Recuperation de beaucoup de donnees de fichier hmt
Bonjour je suis nouveau sur ce forum mais je l'ai utilisé plusieurs fois pour m'aider à développer des macros.
J'ai développé une macro pour récupérer les données d'une machine au format HMT et les mettre dans un fichier EXCEL pour que cela soit exploitable. Ma macro fonctionne si le fichier HMT n'est pas trop gros.
Mais elle bloque au collage des données quand il y a trop de ligne ( > 70 000 lignes)
merci de votre aide
ci joint ma macro :
Sub RécupérationDonnées()
'Variables utilisées
Dim MonHTML As String, fichier As String, x As String, y As String, Eléments As Object ' variable pour le transfert
Dim j, text, WIRE, CRIMP, PULL, a, jour, b, c, d, e ' variable pour le trie
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Dim resultat As String
line2:
'Création de la boite de dialogue pour entrer la date voulue
x_date = InputBox("Indiquer le mois voulue (MM)")
y_date = InputBox("Indiquer le jour voulue (JJ)")
e = Worksheets("Text").Range("f1").Value
Worksheets("Text").Range("d" & e).Value = x_date
Worksheets("Text").Range("e" & e).Value = y_date
e = e + 1
Worksheets("Text").Range("f1").Value = e
'Recherche du fichier
x = FreeFile
fichier = "Z:\ZETA\2020\" & x_date & "\" & y_date & "\Production state data.htm"
If FichierExiste(fichier) = False Then
MsgBox "Le fichier n'existe pas..."
GoTo line2
End If
Open "Z:\ZETA\2020\" & x_date & "\" & y_date & "\Production state data.htm" For Input As #x
MonHTML = Input(LOF(x), #x)
Close #x
'Document HTML virtuel en late binding
With CreateObject("htmlfile")
.write MonHTML
'Recherche un tableau dans la page
Set Eléments = .getelementsbytagname("*")(0)
'Place le code outerhtml de cette table dans le clipboard du document html virtuel et colle dans la feuille de données
If .parentWindow.clipboardData.setData("Text", Eléments.outerhtml) Then
Application.ScreenUpdating = False
'Mets les données dans la feuille données voulue
With Sheets(3)
.Activate
.Cells.Clear
Cells(1, 1).Select
.Paste
End With
Application.CutCopyMode = False
.parentWindow.clipboardData.clearData "Text"
End If
End With
end sub
Bonjour
Peux-tu poster un exemple de fichier hmt ?
bonjour merci de votre aide
mais je ne peux pas mettre un fichier joints : le site me renvoie un message d'erreur " extension du fichier non prise en charge"
est ce qu'il y a une autre solution pour vous joindre un fichier ?
RE
Oui dans un zip
ok ci joint le fichier zip
Bonjour
htm et non hmt...
C'est sûr qu'un copier coller n'est pas adapté
Ton fichier semble incomplet : pas de balise terminant les structures en cours
Il ne s'ouvre pas en tant que source html même dans Excel 365 34bits
Il est donc possible qu'il y ait une limite de taille.
As-tu un exemple de qui est fait ensuite du contenu ?
Il y a quelques années j'ai eu pas mal de html soit à lire soit à générer avec Excel.
Souvent l'appel à Word via le VBA Excel permettait de résoudre divers PB
ci joint un fichier pour lequel cela fonctionne.
j'ai ouvert le fichier sous word que je vous avais envoyé : 4090 pages !!!
je fais une recherche suivant 4 critères et je met le résultat dans la feuille RESULTAT
ci joint la suite de la macro:
Set twb = ThisWorkbook
jour = Worksheets("Feuil3").Range("b4").Value ' date de la recherche
WIRE = Worksheets("Text").Range("a1").Value ' critère WireLength
CRIMP = Worksheets("Text").Range("a2").Value ' critére CrimpHeight
PULL = Worksheets("Text").Range("a3").Value 'critère PullOffForce
SAMPLE = Worksheets("Text").Range("a4").Value 'critère échantillon
a = Worksheets("RESULTAT").Range("b1").Value 'nombre de ligne du fichier
Col = "A" ' colonne de la donnée non vide à tester
NumLig = 0
NbrLig = Worksheets("Feuil3").Range("A" & Rows.Count).End(xlUp).Row 'calcul du nombre de ligne
For j = 2 To NbrLig
Worksheets("Feuil3").Range("e" & j).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 1, 11) 'découpe texte wire lenght
text = Worksheets("Feuil3").Range("e" & j).Value
If text = WIRE Then
b = j - 2
c = j - 15
Worksheets("RESULTAT").Range("c" & a).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 13, 11) ' ref fil
Worksheets("RESULTAT").Range("e" & a).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 26, 4) 'resultat test long
Worksheets("RESULTAT").Range("d" & a).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 32, 3) ' longueur
Worksheets("RESULTAT").Range("b" & a).Value = Mid(Worksheets("Feuil3").Range("a" & b).text, 19, 8) 'heure
Worksheets("RESULTAT").Range("a" & a).Value = jour
a = a + 1
End If
If text = CRIMP Then
b = j - 2
c = j - 15
Worksheets("RESULTAT").Range("c" & a).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 14, 11) ' ref fil
Worksheets("RESULTAT").Range("f" & a).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 26, 11) ' ref cosse
Worksheets("RESULTAT").Range("i" & a).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 39, 4) ' résultat
Worksheets("RESULTAT").Range("g" & a).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 45, 5) ' hauteur
Worksheets("RESULTAT").Range("b" & a).Value = Mid(Worksheets("Feuil3").Range("a" & b).text, 19, 8) 'heure
Worksheets("RESULTAT").Range("a" & a).Value = jour
a = a + 1
End If
If text = PULL Then
b = j - 2
c = j - 15
Worksheets("RESULTAT").Range("c" & a).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 15, 11) ' ref fil
Worksheets("RESULTAT").Range("f" & a).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 27, 11) ' ref cosse
Worksheets("RESULTAT").Range("i" & a).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 40, 4) ' résultat
Worksheets("RESULTAT").Range("h" & a).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 46, 5) ' tenue
Worksheets("RESULTAT").Range("b" & a).Value = Mid(Worksheets("Feuil3").Range("a" & b).text, 19, 8) 'heure
Worksheets("RESULTAT").Range("a" & a).Value = jour
a = a + 1
End If
If text = SAMPLE Then
b = j + 2
c = j + 5
Worksheets("RESULTAT").Range("b" & a).Value = Mid(Worksheets("Feuil3").Range("a" & j).text, 24, 8) ' heure
Worksheets("RESULTAT").Range("j" & a).Value = Mid(Worksheets("Feuil3").Range("a" & b).text, 13, 18) ' référence
'Worksheets("TEXT").Range("a6").Value = Mid(Worksheets("Feuil3").Range("a" & c).text, 28, 8) ' quantité
' Worksheets("TEXT").Range("a7").Value = Len(Worksheets("Text").Range("A6").Value) 'recupération et transformation de la quantité
' d = Worksheets("Text").Range("a7").Value
' d = d - 4
Worksheets("TEXT").Range("a7").Value = Len(Worksheets("Feuil3").Range("a" & c).Value)
d = Worksheets("Text").Range("a7").Value
d = d - 28
Worksheets("RESULTAT").Range("k" & a).Value = Mid(Worksheets("Feuil3").Range("a" & c).text, 29, d) 'quantité produite
'Worksheets("RESULTAT").Range("k" & a).Value = Mid(Worksheets("Text").Range("a6").text, 1, d) 'quantité produite
Worksheets("RESULTAT").Range("a" & a).Value = jour
a = a + 1
End If
Worksheets("RESULTAT").Range("b1").Value = a
Next j
Application.Goto (ActiveWorkbook.Sheets("RESULTAT").Range("A2"))
'
End Sub
Public Function FichierExiste(MonFichier As String)
If Len(Dir(MonFichier)) > 0 Then
FichierExiste = True
Else
FichierExiste = False
End If
End Function
RE
Sans les critères de la feuille Text...
Poste juste quelques lignes de l’onglet RESULTAT, ce sera plus simple pour répondre à ma question
ci joint les 4 critères de la feuille TEXT :
en a1 ="WireLength"
en a2 = "CrimpHeight"
en a3= "PullOffForc"
en a4 ="ProductionT"
RE
C'est épuisant de devoir poser n fois la même demande pour aider
e = Worksheets("Text").Range("f1").Value
on a pas f1
Pourquoi tourner autour du pot et ne pas poster simplement ce que je demande ?
e = Worksheets("Text").Range("f1").Value ' valeur de la ligne pour stock les valeurs x_date et y_date
Worksheets("Text").Range("d" & e).Value = x_date
Worksheets("Text").Range("e" & e).Value = y_date
e = e + 1
Worksheets("Text").Range("f1").Value = e
e s'incrémente à chaque recherche et comme à 2
je vous ai envoyé la vue du résultat
RE
Le pdf ne montre pas les lignes et colonnes EXCEL et manifestement le code écrit au-dessus des titres
Ton code est pas mal bricolé, notamment pour les quantités, et les données ne dont pas homogènes : dans le gros htm les séquences ProductionTerminated n'ont toujours la ligne Job ce qui interdit les décalages b et c par rapport à j
D'ailleurs c est défini pour les 4 cas mais utilisé pour un seul...
Il n'y a que 2 des 4 cas et en petite quantité (18 en tout) pour plus de 150 000 lignes de données donc je n'ai pu voir si d'autres incohérences
Le traitement irait beaucoup plus vite si on ne copiait pas les données sur feuill3 mais si on traitait directement en mémoire
Il faudrait donc faire une table de correspondance entre
les colonnes de l'onglet RESULTAT et les libellés des lignes de l'htm pour chacun des 4 cas
Par exemple
pour ProductionTerminated : heure sur même ligne et Quantité sur ligne ProductionRequestedPieces
pour WireLength : heure sur MeasurementData précédente, ...
Si j'ai bien compris RESULTAT s'enrichit au fil d'imports successifs ?