Discussion :

[licpegpon]

Bonjour,

Dans la colonne B du fichier "schema.xlsx" (onglet "feuil1") je trouve le titre du document. Cette colonne comporte pratiquement 400000 lignes (donc 400000 titres différents). J'ai par exemple en cellule B2 le texte suivant :

M768_IP_Special detailed installation of fuse external structure, panel 38 splicing at DET43, GH/KH_ID4606 postmod


Ce texte est mémorisé dans un tableau TAB_SCHEMA(). Il s'agit en fait de la valeur TAB_SCHEMA(1,2) car la première ligne correspond à l'entête et n'est pas mémorisée dans le tableau : valeur de la 1ère ligne et 2ème colonne de ce tableau.

Je voudrais extraire du titre le numéro de l'ID. Dans le cas présenté plus haut le numéro de l'ID serait égal à 4606. Je précise qu'il y a toujours 4 chiffres juste après le texte "ID". Le texte IDxxxx peut se situer n'importe où dans le texte (en général vers la fin).

Cette extraction serait faite sur toute la colonne (environ 400000 lignes). Beaucoup de titres ne possèdent pas d'ID dans ce cas on met un vide. L'ensemble des résultats seraient stockés dans un deuxième tableau (par exemple TAB_ID()) qui comporterait en 1ère colonne l'ID et en deuxième le titre.

Ce tableau (2 colonnes) ressemblerait à :

4606 M768_IP_Special detailed installation of fuse external structure, panel 38 splicing at DET43, GH/KH_ID4606 postmod
5307
5478 Z435 essai de fatigue ID5478
4804
4342 ER567 stockage dans le hangar B45 ID4342
...
...

Des suggestions ? Merci par avance.

Cdlt.
Jérôme.

[Patrice740]

Bonjour,

Pour extraire l'ID du texte :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
Sub test()
Dim str As String
 
  str = "M768_IP_Special detailed installation of fuse external structure, panel 38 splicing at DET43, GH/KH_ID4606 postmod"
  MsgBox ExtraireID(str)
 
End Sub
 
Function ExtraireID(s As String) As String
Dim id As String
  id = Mid("IDxxxx" & s, InStrRev("IDxxxx" & s, "ID") + 2, 4)  'si pas d'ID on obtient xxxx
  If Format(Val(id), "0000") = id Then ExtraireID = id Else ExtraireID = ""
End Function

Tu n'a plus qu'à boucler sur les valeurs de ton tableau.

[licpegpon]

Bonjour Patrice740,

Merci beaucoup. Désolé pour le silence radio, des priorités autres .....

Cdlt.
Jérôme

[patricktoulon]

bonsoir patrice

je comprends pas trop ton ajout de texte "idxxxx" tout du moins son utilité

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
Sub test()
    Dim str As String
    str = "M768_IP_Special detailed installation of fuse external structure, panel 38 splicing at DET43, GH/KH_ID4606 postmod"
    MsgBox ExtraireID(str)
    str = "M768_IP_Special detailed installation of fuse external structure, panel 38 splicing at DET43, GH/KH_OD4606 postmod"
    MsgBox ExtraireID(str)
End Sub
Function ExtraireID(s As String) As String
    Dim x
    x = InStrRev(s, "ID")
    ExtraireID = IIf(x > 0, Val(Mid(s, x + 2)), "")
End Function

et toujours en espérant que les chaines soit de même acabit

[Patrice740]

Bonjour Patrick

bonsoir patrice
je comprends pas trop ton ajout de texte "idxxxx" tout du moins son utilité

C'est dans l’énoncé du problème :

.... Je précise qu'il y a toujours 4 chiffres juste après le texte "ID". Le texte IDxxxx peut se situer n'importe où dans le texte (en général vers la fin).
Beaucoup de titres ne possèdent pas d'ID dans ce cas on met un vide.

Ça résout simplement (pas besoin de test IF ou IIF) le cas de présence de 'ID' mais d'absence de 'ID' suivi de 4 chiffres, par exemple

Code :

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

str = "M768_ID_Special detailed installation of fuse external structure, panel 38 splicing at DET43, GH/KH_OD4606 postmod"

[patricktoulon]

re
dans l'énoncé IDxxxx est une expression dans son explication

pour en revenir a ton modèle si je comprends bien tu récupère soit ID4096 soit IDxxxx et tu test avec un IF format si c'est bien numérique

[Patrice740]

Re,

si je comprends bien tu récupère soit ID4096 soit IDxxxx et tu test avec un IF format si c'est bien numérique

C'est exactement ça.
C'est une technique que j'emploie fréquemment avec InStr & InStrRev (i.e. InStrRev("xx" & s, "xx")) pour être certain que la chaine cherchée soit trouvée.
PS : et le test avec Format permet de s'assurer qu'il y a bien 4 chiffres ni plus ni moins.

[patricktoulon]

RE
je suis plutôt adepte d'astuce de ce genre
mais dans le cas présent pensant gérer la récup des 4 chiffres et control avec format tu néglige le fait qu'il puisse y avoir plusieurs sous chaine "ID....." dans la chaine
et que la bonne ne soit pas la dernière

test celle ci avec ta fonction

Code :

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

1
2
str = "M768_IP_Special detailed installation of fuse external structure,GH/KH_ID4606 panel 38 splicing at DET43, ABCDEFIDGHIJKL postmod"
    MsgBox ExtraireID(str)

celle ci est moins jolie mais elle donnera le id en toute circonstance

Code :

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

1
2
3
4
5
6
7
Function ExtraireID(s As String) As String
    Dim tbl, elem
    tbl = Split(s, "ID")
    For Each elem In tbl
        If Format(Val(Left(elem, 4)), "0000") = Left(elem, 4) Then ExtraireID = Left(elem, 4)
    Next
End Function

[licpegpon]

Bonjour à vous (PatrickToulon et Patrice740),

J'avoue avoir zappé les échanges, j'ai essayé d'avancer de mon côté. Voici un premier jet (qui plante mais bon...) :

Je copie des données d'un tableau dans un autre mais je pense qu'il doit y avoir un problème pour la déclaration du tableau TAB_ID(). La déclaration du tableau TAB_SCHEMA semble OK par contre. Je ne sais pas comment déclarer TAB_ID() ?
A l'exécution j'ai le message comme quoi la fonction n'est pas définie ? Où, comment dois-je la déclarer ?

Je précise que j'ai copié la fonction ci dessous dans "Thisworkbook". Pas sûr de mon coup ?

Code :

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

1
2
3
4
5
Function ExtraireID(s As String) As String
Dim id As String
  id = Mid("IDxxxx" & s, InStrRev("IDxxxx" & s, "ID") + 2, 4)  'si pas d'ID on obtient xxxx
  If Format(Val(id), "0000") = id Then ExtraireID = id Else ExtraireID = ""
End Function

Voici l'état actuel de la procédure

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Option Explicit
Sub ECM()
'
'Déclaration des variables
'
Dim derniere_ligne As Long
Dim Tab_SCHEMA() As Variant
Dim Tab_ID() As Variant
Dim str As String
Dim i As Integer
Dim classeur As String
Dim statusBarInitial As Long
'
'Ouverture du fichier schema.xml_temporary.xlsx
'On se positionne dans l'onglet "schema.xml_temporary"
'
classeur = Application.GetOpenFilename(, 1, "Select 'schema.xml_temporary.xlsx' file", , False)
Workbooks.Open classeur
Sheets("schema.xml_temporary").Activate
'
derniere_ligne = Range("A" & Rows.Count).End(xlUp).Row
'
MsgBox ("Dernière ligne = ") & derniere_ligne
'
'La ligne d'instruction ci-dessous suffit à elle seule pour remplir le tableau !!
'La zone mise en mémoire part de la 2ème ligne --> Range("A2") jusqu'à la ligne "derniere_ligne - 1"
'Le tableau contient 52 colonnes et "derniere_ligne - 1" lignes
'
Tab_SCHEMA = Range("A2").Resize(derniere_ligne - 1, 52).Value
'
MsgBox ("Data storage is complete. The repatriation of the data will begin.")
'
'MsgBox ("1  2 = ") & Tab_SCHEMA(1, 2)
'MsgBox ("1  48 = ") & Tab_SCHEMA(1, 48)
'MsgBox ("399458  2 = ") & Tab_SCHEMA(399458, 2)
'MsgBox ("399458  48 = ") & Tab_SCHEMA(399458, 48)
'MsgBox ("399458  49 = ") & Tab_SCHEMA(399458, 49)
'
'Fermer le classeur actif
'
ActiveWorkbook.Close SaveChanges:=False
'
'Ouverture du fichier FOLLOW_UP_TEST.xlsm
'On se positionne dans l'onglet "ECM"
'
classeur = Application.GetOpenFilename(, 1, "Select 'FOLLOW_UP_TEST.xlsm' file", , False)
Workbooks.Open classeur
Sheets("ECM").Activate
'
Range("A1").Select
'
statusBarInitial = Application.DisplayStatusBar
Application.DisplayStatusBar = True
'
'Extraction de l'ID de tous les "Document title"
'
For i = 1 To derniere_ligne - 1
 
Application.StatusBar = "Calcul en cours... " & i & " / " & derniere_ligne - 1
 
str = Tab_SCHEMA(i, 2)
Tab_ID(i, 1) = ExtraireID(str)
Tab_ID(i, 2) = Tab_SCHEMA(i, 2)
Tab_ID(i, 3) = Tab_SCHEMA(i, 3)
Tab_ID(i, 4) = Tab_SCHEMA(i, 4)
Tab_ID(i, 5) = Tab_SCHEMA(i, 5)
Tab_ID(i, 6) = Tab_SCHEMA(i, 22)
Tab_ID(i, 7) = Tab_SCHEMA(i, 23)
Tab_ID(i, 8) = Tab_SCHEMA(i, 24)
Tab_ID(i, 9) = Tab_SCHEMA(i, 25)
Tab_ID(i, 10) = Tab_SCHEMA(i, 36)
Tab_ID(i, 11) = Tab_SCHEMA(i, 37)
 
Next
'
'
'Ecriture des résultats dans l'onglet "ECM"
'
For i = 1 To derniere_ligne - 1
 
Cells(i + 2, 2) = Tab_ID(i, 1)
Cells(i + 2, 3) = Tab_ID(i, 2)
Cells(i + 2, 4) = Tab_ID(i, 3)
Cells(i + 2, 5) = Tab_ID(i, 4)
Cells(i + 2, 6) = Tab_ID(i, 5)
Cells(i + 2, 7) = Tab_ID(i, 6)
Cells(i + 2, 8) = Tab_ID(i, 7)
Cells(i + 2, 9) = Tab_ID(i, 8)
Cells(i + 2, 10) = Tab_ID(i, 9)
Cells(i + 2, 11) = Tab_ID(i, 10)
 
Next
'
End Sub

Merci à vous.

Cdlt.
Jérôme