Discussion :

[docjo]

Bonjour à tous

Je récupère un texte multilignes que je souhaite importer dans une table avec 2 colonnes: Produit; Dose
Voici un exemple de texte:

1000 ml POLYIONIQUE G5
PRF de 1000 mL sur 24h00 à 09h pendant 4 jour(s)
CALCIPARINE SC 12 500 iu/0.5 mL, sol inj, amp
1,2 mL / jour pendant 30 jour(s), 0,4 mL à 04h, 0,4 mL à 12h, 0,4 mL à 20h
DOLIPRANE (PARACETAMOL) 1*000 MG, CPR
4 cpr / jour pendant 7 jour(s), 1 cpr à 08h, 1 cpr à 12h, 1 cpr à 18h, 1 cpr à 22h
INEXIUM 40 mg, cpr gastro-résistant
1 cpr / jour pendant 7 jour(s), 1 cpr à 20h
KARDEGIC 160 mg, pdr pr sol buv, sachet
1 sachet / jour pendant 10 jour(s), 1 sachet à 12h
PROFENID (KETOPROFENE) 50 MG, GÉLULE
4 gel / jour pendant 3 jour(s), 1 gel à 08h, 1 gel à 12h, 1 gel à 18h, 1 gel à 22h

La première ligne contient le produit puis la 2ième la dose, la 3ième un nouveau produit et 4ième sa dose, etc...Ce texte est toujours formaté comme cela.
Le texte ci-dessus dois donc donner:

Produit

Dose

1000 ml POLYIONIQUE G5 [INDENT]PRF de 1000 mL sur 24h00 à 09h pendant 4 jour(s)
CALCIPARINE SC 12 500 iu/0.5 mL, sol inj, amp

0,4 mL, 0,4 mL, 0,4 mL

DOLIPRANE (PARACETAMOL) 1*000 MG, CPR

1 cpr, 1 cpr, 1 cpr, 1 cpr

INEXIUM 40 mg, cpr gastro-résistant

1 cpr

KARDEGIC 160 mg, pdr pr sol buv, sachet

1 sachet

PROFENID (KETOPROFENE) 50 MG, GÉLULE

1 gel , 1 gel , 1 gel , 1 gel

Remarquez que la dose coupe à ", " au début et " à" à la fin.

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
 
Function ctrlC_coller()
 
 
Dim TabAs() As String
Dim TabSql() As String
Dim Txt1 As String
Dim Txt2 As String
 
Dim strcopie As String
 
'Gestion des erreurs
On Error Resume Next
'Récupère le presse papier
strcopie = Clipboard2Text()
'Extraction selon le saut de ligne
TabAs = Split(strcopie, vbCrLf)
 
Dim i As Long
 
For i = 0 To UBound(TabAs) Step 2 'Parcours du tableau
    Txt1 = Mid(TabAs(i), 1)
    Txt2 = Txt2 & Txt1
Next i
 
    Debug.Print Txt2
 
End Function

Ce Code isole le produit et j'imagine bien insérer dans la table Txt1 dans la colonne "Produit". Si je démarre le for à 1, j'isole la dose. Mais comment découper cette boucle avec le critère ", " au début et " à" à la fin ? J'ai essayé toutes les combinaisons mais je n'y arrive pas.
Je vous serai reconnaissant si vous pouviez m'indiquer une stratégie pour y arriver.

[pc75]

Bonjour,

La fonction InStrRev() retourne la position d'une sius-chaîne à partir de la fin.
Donc

Code :

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

InStrRev(LaChaine, ",")

te donne la position de départ et

Code :

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

InStrRev(LaChaine, ",")

celle de fin.
Tu n'as plus qu'à utiliser la fonction Mid()

EDIT : Tiens j'avais 2 minutes :

Code :

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

1
2
3
4
5
 
chaine = "1,2 mL / jour pendant 30 jour(s), 0,4 mL à 04h, 0,4 mL à 12h, 0,4 mL à 20h"
Deb = InStr(chaine, "jour(s),") + 9
Fin = InStr(chaine, "à")
MsgBox Mid(chaine, Deb, Len(chaine) - (Fin + 1))

[docjo]

Merci pc75. Si j'utilise cela:

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
 
Function ctrlC_coller()
 
 
Dim TabAs() As String
Dim TabDose() As String
Dim Txt1 As String
Dim Txt2 As String
Dim Txt3 As String
Dim Txt4 As String
Dim Txt5 As String
Dim Txt6 As String
Dim strcopie As String
 
'Gestion des erreurs
On Error Resume Next
'Récupère le presse papier
strcopie = Clipboard2Text()
'Extraction selon le saut de ligne
TabAs = Split(strcopie, vbCrLf)
 
Dim i, k As Long
 
For i = 0 To UBound(TabAs) Step 2 'Parcours du tableau
    Txt1 = Mid(TabAs(i), 1)
    Txt2 = Mid(TabAs(i + 1), InStr(1, TabAs(i + 1), ", ") + 1)
    TabDose = Split(Txt2, "à ")
    For k = 0 To UBound(TabDose) - 1
    If Mid(TabDose(k), 1) Like "*, *" Then
    Txt3 = Mid(TabDose(k), InStr(1, TabDose(k), ", ") + 1)
    Else
    Txt3 = Mid(TabDose(k), 1)
    End If
    Txt4 = Txt4 & "-" & Txt3
    Next k
    Txt5 = Txt5 & Txt1 & Txt4 & vbCrLf
 
 
Next i
 
     Debut.print Txt5

J'obtiens:

1000 ml POLYIONIQUE G5-PRF de 1000 mL sur 24h00
CALCIPARINE SC 12 500 iu/0.5 mL, sol inj, amp-PRF de 1000 mL sur 24h00 - 0,4 mL - 0,4 mL - 0,4 mL
DOLIPRANE (PARACETAMOL) 1*000 MG, CPR-PRF de 1000 mL sur 24h00 - 0,4 mL - 0,4 mL - 0,4 mL - 1 cpr - 1 cpr - 1 cpr - 1 cpr
INEXIUM 40 mg, cpr gastro-résistant-PRF de 1000 mL sur 24h00 - 0,4 mL - 0,4 mL - 0,4 mL - 1 cpr - 1 cpr - 1 cpr - 1 cpr - 1 cpr
KARDEGIC 160 mg, pdr pr sol buv, sachet-PRF de 1000 mL sur 24h00 - 0,4 mL - 0,4 mL - 0,4 mL - 1 cpr - 1 cpr - 1 cpr - 1 cpr - 1 cpr - 1 sachet
PROFENID (KETOPROFENE) 50 MG, GÉLULE-PRF de 1000 mL sur 24h00 - 0,4 mL - 0,4 mL - 0,4 mL - 1 cpr - 1 cpr - 1 cpr - 1 cpr - 1 cpr - 1 sachet - 1 gel - 1 gel - 1 gel - 1 gel

au lieu de:

1000 ml POLYIONIQUE G5-PRF de 1000 mL sur 24h00
CALCIPARINE SC 12 500 iu/0.5 mL, sol inj, amp-PRF de 1000 mL sur 24h00 - 0,4 mL - 0,4 mL - 0,4 mL
DOLIPRANE (PARACETAMOL) 1*000 MG, CPR-PRF de 1000 mL sur 24h00 - 1 cpr - 1 cpr - 1 cpr - 1 cpr
INEXIUM 40 mg, cpr gastro-résistant-PRF de 1000 mL sur 24h00 - 1 cpr
KARDEGIC 160 mg, pdr pr sol buv, sachet-PRF de 1000 mL sur 24h00 - 1 sachet
PROFENID (KETOPROFENE) 50 MG, GÉLULE-PRF de 1000 mL sur 24h00 - 1 gel - 1 gel - 1 gel - 1 gel

Arg! J'y suis presque !

[Tofalu]

A la première boucle for, à chaque passage, il vous faut réinitialiser la variable txt4

[docjo]

Mille merci. J'avais eu l'idée avec Txt3 mais pas avec Txt4. Voici donc le code final

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
 
Function ctrlC_coller()
 
 
Dim TabAs() As String
Dim TabDose() As String
Dim Txt1 As String
Dim Txt2 As String
Dim Txt3 As String
Dim Txt4 As String
Dim Txt5 As String
Dim Txt6 As String
Dim strcopie As String
 
'Gestion des erreurs
On Error Resume Next
'Récupère le presse papier
strcopie = Clipboard2Text()
'Extraction selon le saut de ligne
TabAs = Split(strcopie, vbCrLf)
 
Dim i, k As Long
'Première  boucle afin d'isoler les lignes par les sauts de ligne, en prenant 1 ligne sur 2
For i = 0 To UBound(TabAs) Step 2 
    Txt1 = Mid(TabAs(i), 1)
    Txt2 = Mid(TabAs(i + 1), InStr(1, TabAs(i + 1), ", ") + 1)
    TxT4=""
 
    'Nouveau découpage aprés les doses
    TabDose = Split(Txt2, "à ")
    For k = 0 To UBound(TabDose) - 1
    If Mid(TabDose(k), 1) Like "*, *" Then
    Txt3 = Mid(TabDose(k), InStr(1, TabDose(k), ", ") + 1)
    Else
    Txt3 = Mid(TabDose(k), 1)
    End If
    Txt4 = Txt4 & "-" & Txt3
    Next k
 
    'On reconstitue le texte. Remplacer ici par l'alimentation dans une table si besoin
    Txt5 = Txt5 & Txt1 & Txt4 & vbCrLf
 
 
Next i
 
     'Juste pour voir ce que cela donne dans l'explorateur
     Debut.print Txt5

Merci encore à tous