Discussion :

[djool]

Bonjour,

Nous sommes entrain de changer de logiciel de gestion, et je me trouve confronté à un soucis pour la récupération des désignation articles.

Voila mon soucis :

Notre nouveau logiciel (PMISOFT) a 2 champs libellés principaux acceptant maximum 30 caractères. Notre ancien logiciel (APIBAT), a des champs acceptant jusqu'à 90 caractères.

J'ai récupéré les tables oracles d'APIBAT dans access afin de passer tout ça à la "moulinette".

JE souhaiterais donc extraire les 30 premiers caractères de mes désignations mais sans couper les mots. Car j'ai déjà récupéré ces 30 premiers caractères mais ça tronque les derniers mots et ce n'est pas très propre.

Donc je souhaiterais par une fonction identifier les caractères 30 et 31 de chaque chaine et si l'un de ces 2 caractères est un espace alors je peux extraire les 30 premiers caractères de cette chaine.

En revanche, si ces 2 caractères ne sont pas un espace, je voudrais extraire une chaines allant jusqu'au dernier espace compris dans les 30 premiers caractères.

Je ne sais pas si c'est très clair.

J'espère que vous pourrez me répondre

Merci d'avance

[Jean-Philippe André]

Salut,

les fonctions de manipulations de chaines d caractères à voir ici soçnt :
-Instr()
-Mid()
-Left()
-Right()

une fonction que j'utilise, à adapter évidemment

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
 
Sub Piou()
MsgBox RecupererTexteEntreBornes("Ceci est ma phrase test","Ceci","test")
End Sub
 
Function RecupererTexteEntreBornes(texte As String, textedebut As String, textefin As String) As String
Dim result As String
Dim debut As Integer
Dim fin As Integer
    debut = InStr(1, texte, textedebut)
    fin = InStr(debut + Len(textedebut), texte, textefin)
    result = ""
    If debut > 0 Then
        If fin > debut + Len(textedebut) Then
            result = Mid(texte, debut + Len(textedebut), fin - debut - Len(textedebut))
        Else
            result = Right(texte, Len(texte) - debut - Len(textedebut) + 1)
        End If
    End If
    RecupererTexteEntreBornes = result
End Function

[djool]

merci de ta réponse si rapide

J'ai reussi à identifier mais dernier espace dans chaque chaine de caractere par :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
  Function LastOccurence(strString As String, strCharacter As String) As Integer
    Dim intPosition As Integer
 
     intPosition = 1
 
     While intPosition <= Len(strString) And strCharacter <> "" And InStr(intPosition, strString, strCharacter) <> 0
     intPosition = InStr(intPosition, strString, strCharacter)
     LastOccurence = intPosition
     intPosition = intPosition + 1
     Wend
     End Function

Mais bon ce n'était qu'un petit premier pas, alors je vais essayer ta fonction

Merci encore de ton aide

[djool]

Me revoila,

Voila ce que je viens de faire, ce n'est certainement pas très cartesien mais bon je fais avec mes petites connaissances et votre aide. ça marche pas trop mal en tous les cas
Mais je suis preneur de toutes amélioration.

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
 Function Libelle1(strString As String) As String
    Dim lib As String
    Dim charact1 As String
    Dim charact2 As String
    Dim strString2 As String
    Dim intpositioncharact3 As Integer
 
 
    charact1 = Mid(strString, 30, 1)
    charact2 = Mid(strString, 31, 1)
    strString2 = Mid(strString, 1, 30)
    intpositioncharact3 = LastOccurence(strString2, " ")
 
 
    If charact1 = " " Then
    lib = Mid(strString, 1, 30)
    End If
    If charact2 = " " Then
    lib = Mid(strString, 1, 30)
    End If
    If charact1 <> " " Then
    lib = Mid(strString, 1, intpositioncharact3)
    End If
   Libelle1 = lib
 
    End Function

Voila je suis resté sur la base de départ car j'aime aller jusqu'au bout de mon raisonnement même si je me plante au moins je comprends pourquoi.

[ucfoutu]

Bonsoir,

Fonction :

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Function tronquons(quoi As String, limite As Integer) As String
  Dim titi As String
  titi = Left(quoi, limite)
  If Not Mid(quoi, limite + 1, 1) = " " Then
    While Mid(titi, Len(titi), 1) <> " "
      titi = Left(titi, Len(titi) - 1)
    Wend
  End If
  tronquons = Trim(titi)
End Function

Appelable ainsi (exemple)

Code :

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

1
2
3
Dim toto As String
  toto = "abracadabra voilà le grand zèbre qui joue beaucoup à saute-mouton dans le pré du voisin."
  MsgBox tronquons(toto, 50)

devrait suffire...

[helas]

sinon

Code :

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

1
2
3
4
 
Private Function tronquons(quoi As String, limite As Integer) As String
  tronquons = Left$(quoi,instrrev(quoi," ",limite))
End Function

[ucfoutu]

Bonjour, helias,

je n'ai personnellement pas voulu utiliser instrrev qui s'avèrerait un chouia (mais je suis avare) plus lent que la recherche par une boucle qui, elle, s'arrêtera presque immédiatement.

Maintenant, attention :
Si tu utilises ta manière, il faut écrire ainsi :

Code :

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

1
2
3
Private Function tronquons(quoi As String, limite As Integer) As String
 tronquons = Trim(Left$(quoi, InstrRev(quoi, " ", limite + 1)))
End Function

Pourquoi ? ===>> tout simplement parce que le "limitième" caractère peut, par coincidence, être bien placé pour le tronquage ===>> ce qui provoquerait un tronquage prématuré à l'espace suivant, en remontant ...

C'est d'ailleurs là la raison de cette ligne, dans mon code :

Code :

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

If Not Mid(quoi, limite + 1, 1) = " "  Then

[ucfoutu]

Et d'ailleurs :
En relisant lentement la question posée, je ne saurais trop conseiller à djool de ne pas se contenter de l'espace comme possibilité de troncage.

Voilà ce que je lui suggère :

1) la fonction :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Function tronquons(quoi As String, limite As Integer) As String
  Dim titi As String, lecar As String, mestroncages As String
  mestroncages = ". ?;,!:"
  titi = Trim(Left(quoi, limite))
  If InStr(mestroncages, Mid(quoi, limite + 1, 1)) Then
    tronquons = titi
  Else
    Do While InStr(mestroncages, Right(titi, 1)) = 0
      titi = Trim(Left(titi, Len(titi) - 1))
    Loop
    titi = Left(titi, Len(titi) - 1)
  End If
  tronquons = Trim(titi)
End Function

2) le code d'appel (iici pour tronquer à 50):

Code :

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

1
2
3
Dim toto As String
  toto = "abracadabra voilà le grand zèbre qui joue, qui joue beaucoup à saute-mouton dans le pré du voisin."
  MsgBox tronquons(toto, 50)

Ce sera plus élégant...

[helas]

Etrange

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
 
Sub test()
 Dim s As String, k As Single
 s = "abracadabra voilà le grand zèbre qui joue, qui joue beaucoup à saute-mouton dans le pré du voisin."
 k = Timer
 For i = 0 To 100000
  v = tronquons(s, 50)
 Next i
 Debug.Print Timer - k
 
 k = Timer
 For i = 0 To 100000
  v = Trim$(Left$(s, InStrRev(s, " ", 50) - 1))
 Next i
 Debug.Print Timer - k
 
End Sub

la première donne 1,859375 s
et la seconde 0,234375 s
qui a dit que instrrev etait plus lent ?

[ucfoutu]

Je sais pas comment tu t'arranges.

Avec ma vielle machine, j'obtiens 0,203125 secondes pour

Code :

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

1
2
3
4
5
k = Timer
 For i = 0 To 100000
  v = tronquons(toto, 50)
 Next i
 Debug.Print Timer - k

Je viens de lancer plusieurs fois ===>>>

0,21875
0,21875
0,21875
0,21875
0,203125

[helas]

J'utilise Access 2002 SP3
Ma machine est un peu agée et le rapport est de 9 à l'avantage de InstrRev. Pourrais-tu donner aussi le temps mis sur ta machine par InstrRev, car c'est la difference de vitesse entre les 2 solutions qui permet un choix ?
Pour ma part, j'ai strictement appliqué le code indiqué dans ces pages.

[batou22003]

Je propose une fonction AvoirLeDernierMot() , qui peut etre appelée dans une requete Access.

Code :

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

maColonne : AvoirLeDernierMot([ColonneATraiter],30)

(c'est pour ca que varMaChaine est un variant).
Pensez aussi aux colonnes pouvant prendre Null ou vide. Adapter la fonction ci-dessous s'il le faut.

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
Function AvoirLeDernierMot(varMaChaine As Variant, limite As Integer) As Variant
Dim intPos As Integer
Dim strTempChaine As String
 
On Error Resume Next
 
If Not IsNull(varMaChaine) Then
 
strTempChaine = Mid(varMaChaine, 1, limite)
'si espace
    If Mid(varMaChaine, limite, 1) = Chr(32) Then
    AvoirLeDernierMot = Trim(strTempChaine)
    Exit Function
    Else
 
 
    intPos = InStrRev(strTempChaine, Chr(32), limite)
 
    If intPos > 0 Then
    AvoirLeDernierMot = Trim(Mid(strTempChaine, 1, intPos))
     Exit Function
    Else
    AvoirLeDernierMot = Trim(strTempChaine)
     Exit Function
    End If
 
    End If
 
Else
AvoirLeDernierMot = ""
End If
 
End Function

[djool]

Bonjour à tous et merci de toutes vos réponses.

Après un petit voyage Marocains pour le boulot me revoilà.

Je vais lire vos réponse avec attention car ce que j'avais fait fonctionne a peu près mais je ne pense pas que se soit le must.

Je vais donc tester vos différentes réponses et tenter d'améliorer tout celà en vous tenant bien évidemment informé.


D'autre part, je vous mets l'ensemble des fonctions qui me permettent de redistribuer mon libellé long dans :
Libellé1 --> premier libellé de 30 caractères
Libellé2--> deuxième libellé de 30 caractères
Libellé3--> troisième libellé pouvant contenir bcp plus de caractère.

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
Function Libelle1(strString As String) As String
    Dim lib As String
    Dim charact1 As String
    Dim charact2 As String
    Dim strString2 As String
    Dim intpositioncharact3 As Integer
 
    Dim x As Integer
 
 
 
 
    charact1 = Mid(strString, 30, 1)
    charact2 = Mid(strString, 31, 1)
    strString2 = Mid(strString, 1, 30)
    intpositioncharact3 = LastOccurence(strString2, " ")
     x = Len(strString)
 
    If x <= 30 Then
    lib = strString
    End If
 
    If x > 30 And charact1 <> " " Then
      lib = Mid(strString, 1, intpositioncharact3)
      End If
 
    If charact1 = " " Then
    lib = Mid(strString, 1, 30)
    End If
    If charact2 = " " Then
    lib = Mid(strString, 1, 30)
    End If
 
   Libelle1 = lib
 
    End Function
 
    Function Libelle2(strString As String) As String
    Dim lib As String
    Dim charact1 As String
    Dim charact2 As String
    Dim strString2 As String
    Dim intpositioncharact3 As Integer
    Dim charact4 As String
    Dim charact5 As String
    Dim intpositioncharact6 As Integer
    Dim strString1 As String
    Dim x As Integer
    Dim y As Integer
    Dim z As Integer
 
 
    ' indification du " " dans la chaine de caracteres
 
    charact1 = Mid(strString, 30, 1)
    charact2 = Mid(strString, 31, 1)
    strString2 = Mid(strString, 1, 30)
    intpositioncharact3 = LastOccurence(strString2, " ")
     x = Len(strString)
    ' extraction des 30 caracteres suivant libelle1 de la chaine sans coupure de mots
 
    If charact1 = " " Then
    strString1 = Mid(strString, 31, 31)
    End If
    If charact2 = " " Then
    strString1 = Mid(strString, 31, 31)
    End If
 
 
    If x > 30 And charact1 <> " " And charact2 <> " " Then
     strString1 = Mid(strString, intpositioncharact3, 31)
 
      End If
 
    ' Création du libelle2
    y = Len(strString1)
    charact4 = Mid(strString1, 30, 1)
    charact5 = Mid(strString1, 31, 1)
    intpositioncharact6 = LastOccurence(strString1, " ")
 
    If y <= 30 Then
    lib = strString1
    End If
    If y > 30 And charact4 <> " " And charact5 <> " " Then
      lib = Mid(strString1, 1, intpositioncharact6)
      End If
 
    If charact4 = " " Then
    lib = Mid(strString1, 1, 30)
    End If
 
    If charact5 = " " Then
    lib = Mid(strString1, 1, 30)
    End If
 
 
 
    Libelle2 = lib
 
    End Function
 
 
  Function Libelle3(strString As String) As String
 
   Dim STR1 As String
   Dim STR2 As String
   Dim STR3  As String
   Dim charact1 As String
   Dim charact2 As String
   Dim intposcharact3 As Integer
   Dim x As Integer
   Dim y As Integer
   Dim z As Integer
   Dim za As Integer
   Dim zb As Integer
   ' longueur libelle2
   x = Len(strString)
 
   ' identification de " " dans la 3ieme chaine de caractères
   charact1 = Mid(strString, 60, 1)
   charact2 = Mid(strString, 61, 1)
   STR1 = Mid(strString, 1, 60)
   intposcharact3 = LastOccurence(STR1, " ")
   y = Len(STR1)
   z = Len(Libelle1(strString))
   za = Len(Libelle2(strString))
   zb = z + za
 
   ' extraction fin designation
 
   If charact1 = " " Then
   STR2 = Mid(strString, 61, 255)
   End If
 
   If charact2 = " " Then
   STR2 = Mid(strString, 61, 255)
   End If
   If x > 61 And charact1 <> " " And charact2 <> " " Then
   STR2 = Mid(strString, zb, 255)
    End If
   Libelle3 = STR2
 
   End Function

Ma dernière fonction ne me convient que très peu car j'aurais préféré pouvoir faire :
Désignation initiale - (FunctionLibelle1 + FunctionLibellé2)
Mais cela me génère un message d'erreur.

Dans l'attente d'un commentaire sur ces dernières...
Encore merci