Probème avec strings.replace

Version imprimable

Bonjours je suis actuellement étudiant en mécanique et production et je suis en train de faire un petit module Excel pour me faciliter la vie. Malheureusement je débute tout juste et certaines fonctions me donnent du file retordre...

En gros pour ceux qui connaissent les ajustements arbre alésage, je fais une macro qui automatise le système. C'est plus rapide et plus sûr que de se référer à 3 tableaux en même temps ^^

Donc voila dans une colonne de mon tableau se trouve dans toute les cellules une valeur plus delta (ex: -1+D), et je souhaite remplacer le "+D" par rien ("") pour ensuite utilisé la valeur (ici -1) dans un calcul. Je suis alors tombé sur Strings.replace qui apparemment résout mon problème mais ça marche toujours pas et je viens de passer quelque heures sur la question. Voici la partie du code concerné:
Code:

1 2 3 4 5 6 7 8 9 10 11 If col = 18 Or col = 20 Or col = 23 Then Dim celmod As String celmod = Strings.Replace(Worksheets("Alesages").Cells(ligne, col), "+D", "") Dim celval As Double celval = Val(celmod) ES = celval + Worksheets("Alesages").Cells(ligne, colq) End If
le but étant de remplacer le "+D" par rien pour ensuite ajouter la valeur de la cellule en colonne "col" a la valeur de la cellule en colonne "colq".

Voila j'espère que vous pourez m'aider et je vous en remercie d'avance. Désolé pour le manque de clarté..

Cordialement

Bonjour,

Peut être comme ceci ? (pas testé) :

Code:

1
2
3
4
5
6
7
8
9
10
 
If col = 18 Or col = 20 Or col = 23 Then
 
    With Worksheets("Alesages")
 
        ES = CDbl(Replace(.Cells(ligne, col), "+D", "") + .Cells(ligne, colq))
 
    End With
 
End If

Hervé.

02/01/2012, 17h07
defluc

Il faudrait que tu nous montres le contenu des cellules.
En pas à pas, que donne le contenu de ta variable après StringReplace ?
Il peut y avoir des problèmes liés au format des cellules (numérique, texte, scientifique)?

Pour la propreté de la programmation, il vaut mieux placer les déclarations en début de programme et indenter les instructions.

Bonne année deux mille douce
02/01/2012, 17h07
ZebreLoup

Bonjour,

Peux-tu préciser où se situe ton problème : ça ne se lance pas ? ça se lance mais il y a un bug ? pas de bug mais ça ne fait pas ce que tu veux ?

Et n'oublie pas quand tu écris du code d'utiliser la balise (en appuyant sur le # dans l'éditeur)

Merci pour vos réponse, j'ai tester sa ne marche pas non plus donc voici le worksheets concerné:

http://data.imagup.com/12/1140238925.JPG

en rouge les colone 18,20 et 23.
en vert les valeur de Delta (D).

et voici le worksheet ou j'ai les donné entré et sortie:

http://data.imagup.com/12/1140239906.JPG

En rouge ce sont les donné d'entré, celle qui nous concerne sont les 3 première donnés.
En vert clair j'ai la serie qui correspond a "col"
la recherce de la ligne se fait automatiquement avec le diamètre.
En Bleu j'ai l'endoit ou s'applique l'erreur.
En vert l'endroit ou s'applique ma fonction, il s'agit du EI et il se calcul a partir du ES du code du mon premier poste.

l'erreur que j'obtient est une erreur #VALEUR, toute les series marche sauf les serie K, M et N.

Merci encore pour votre aide!

[hide]

Code:

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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
Private Sub result_Click()
 
diam12.Text = diam1.Text & " " & class1.Text & " " & qualite1.Text
 
diam13.Value = diam1.Text & " " & class2.Text & " " & qualite2.Text
 
Dim col1, col2, ligne1 As Integer
 
col1 = 2 + Val(qualite1.Text)
col2 = 2 + Val(qualite2.Text)
ligne1 = 5
 
While Val(diam1.Text) < Worksheets("IT").Cells(ligne1, 1) Or Val(diam1.Text) > Worksheets("IT").Cells(ligne1, 2)
ligne1 = ligne1 + 1
Wend
 
IT1.Value = Worksheets("IT").Cells(ligne1, col1)
IT2.Value = Worksheets("IT").Cells(ligne1, col2)
 
'ecarts alesage'
 
Dim EI, ES As Double
Dim col, colq, ligne As Byte
 
'ecart inferieur'
 
col = 3
ligne = 6
 
While Val(diam1.Text) < Worksheets("alesages").Cells(ligne, 1) Or Val(diam1.Text) > Worksheets("alesages").Cells(ligne, 2)
ligne = ligne + 1
Wend
 
While class1.Text <> Worksheets("Alesages").Cells(4, col)
col = col + 1
Wend
 
EI = Worksheets("Alesages").Cells(ligne, col)
 
If col = 14 Then
EI = -(Val(IT1.Text) / 2)
End If
 
'ecart superieur'
 
If Val(qualite1.Text) = 3 Then
colq = 38
End If
 
If Val(qualite1.Text) = 4 Then
colq = 39
End If
 
If Val(qualite1.Text) = 5 Then
colq = 40
End If
 
If Val(qualite1.Text) = 6 Then
colq = 41
End If
 
If Val(qualite1.Text) = 7 Then
colq = 42
End If
 
If Val(qualite1.Text) = 8 Then
colq = 43
End If
 
If col >= 15 Then
 
col = 15
ligne = 6
 
While class1.Text <> Worksheets("alesages").Cells(4, col)
col = col + 1
Wend
 
While Val(diam1.Text) < Worksheets("alesages").Cells(ligne, 1) Or Val(diam1.Text) > Worksheets("alesages").Cells(ligne, 2)
ligne = ligne + 1
Wend
 
If col = 15 Then
col = 15 - 6 + Val(qualite1.Text)
End If
 
ES = Worksheets("Alesages").Cells(ligne, col)
 
If col >= 26 And Val(qualite1.Text) <= 7 Then
ES = (Worksheets("Alesages").Cells(ligne, col) + Worksheets("Alesages").Cells(ligne, colq))
End If
 
EI = ES - Val(IT1.Text)
 
End If
 
ei1.Value = EI
 
'ecarts arbre'
 
Dim ESa, EIa As Double
Dim cola, lignea As Integer
 
'ecart superieur'
 
cola = 3
lignea = 6
 
While class2.Text <> Worksheets("Arbres").Cells(4, cola)
cola = cola + 1
Wend
 
While Val(diam1.Text) < Worksheets("Arbres").Cells(lignea, 1) Or Val(diam1.Text) > Worksheets("arbres").Cells(lignea, 2)
lignea = lignea + 1
Wend
 
ESa = Worksheets("Arbres").Cells(lignea, cola)
 
If cola = 14 Then
ESa = Val(IT2.Text) / 2
End If
 
'ecart inferieur'
 
If cola >= 15 Then
 
cola = 15
lignea = 6
 
While class2.Text <> Worksheets("Arbres").Cells(4, cola)
cola = cola + 1
Wend
 
While Val(diam1.Text) < Worksheets("Arbres").Cells(lignea, 1) Or Val(diam1.Text) > Worksheets("arbres").Cells(lignea, 2)
lignea = lignea + 1
Wend
 
If cola = 15 And Val(qualite2.Text) <> 5 Then
cola = 15 - 6 + Val(qualite2.Text)
End If
 
If cola = 15 And Val(qualite2.Text) = 5 Then
cola = 15
End If
 
If cola = 19 And Val(qualite2.Text) <= 3 Then
cola = cola + 1
End If
 
EIa = Worksheets("Arbres").Cells(lignea, cola)
ESa = EIa + Val(IT2.Text)
 
End If
 
es2.Value = ESa
 
If Val(diam1.Text) > 1 Then
 
ei2.Value = Val(es2.Text) - Val(IT2.Text)
es1.Value = Val(ei1.Text) + Val(IT1.Text)
 
End If
 
jma.Value = (Val(es1.Text) - Val(ei2.Text)) / 1000
jmi.Value = (Val(es2.Text) - Val(ei1.Text)) / 1000
 
End Sub

[/hide]

03/01/2012, 09h58
ZebreLoup

Pour mieux comprendre ce qui se passe, il faudrait que tu nous dises ce qu'il y a dans Worksheets("Alesages").Cells(ligne, col) grace au débuggeur.
Au fait, c'est normal le colq ou c'est une faute de frappe ?

EDIT : pardon je n'avais pas relu ton premier post en entier.

Si tu as un #VALEUR, c'est que tu as mis une formule dans la cellule. Il faudrait je pense ton code complet pour mieux t'aider.
04/01/2012, 13h15
Paro.

Message précédant éditer avec le code :)

PS: J'ai converti toute la macro en UserForm pour donner quelque chose de sympa mais l'erreur se répète toujours avec K,M et N. C'est le code que j'ai fourni, il est plus propre
04/01/2012, 14h11
ZebreLoup

Je ne vois plus de Replace dans ton nouveau code.

Et tu devrais utiliser Option Explicit et bien typer toutes tes variables, comme ça au moins tu auras une erreur (si tu n'en as pas déjà) si à un moment il essaie de mettre du texte dans un numérique.
04/01/2012, 14h26
Paro.
Oui, pardon.
Code:

1 2 3 4 5 6 7 8 9 If col = 18 Or col = 20 Or col = 23 Then With Worksheets("Alesages") ES = CDbl(Replace(.Cells(ligne, col), "+D", "") + .Cells(ligne, colq)) End With End If
C'est comme si le remplacement marchai mais que le chiffre restant et toujours considérai comme tu texte, je pense que c'est pour ca que ca plante mais je n'est aucune idée et pas assez de savoir pour résoudre ca.
04/01/2012, 14h29
ZebreLoup

Essaie de faire ton CDbl seulement sur le Replace
04/01/2012, 14h38
Paro.

Toujours #VALEUR, il y a pas un moyen pour changer le type de la cellule une fois le remplacement fait?

EDIT: Et qu'est ce que option explicit?
04/01/2012, 15h35
ZebreLoup

Option Explicit t'oblige à déclarer toutes tes variables, sinon, il y a erreur à la compilation. Ça peut paraître contraignant mais ça évite des erreurs liées au fautes de frappe par exemple.

Tu pourrais mettre ton fichier ou pas ? Ça me parait plus simple, parce que là, je ne vois pas d'où ça peut venir.
04/01/2012, 15h44
Paro.

1 pièce(s) jointe(s)

Je l'ai ajouter en fichier joint.
Merci pour le temps que tu m'accorde.

Edit: apparemment le fichier avec userform est non valide donc je met l'ancien

Ton problème était simplement que tu n'avais mis le Replace qu'à un endroit alors qu'il y a 3 endroits où il devait être. J'ai modifié ton code pour que ça renvoie une valeur.
Par contre, je n'ai pas essayé de tout comprendre en détail, mais ça m'étonnerait que ton code fasse ce que tu veux, tu cherches 2 fois la colonnes, il y a des tonnes de If qui ne sont pas exclusifs, du coup, la moitié ne servent à rien. As-tu écris sur un papier en français ce que tu voulais faire avant de rédiger ton code ?

Code:

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
Function ALESAGE_EI(diametre As Double, classe As String, qualite As Byte) As Double
 
'Création des élements'
 
    Dim ES, EI As Double
    Dim col, ligne, colq As Integer
 
'Définition de EI'
 
    'Classe de A à H'
 
        col = 3
        ligne = 6
 
        While classe <> Worksheets("Alesages").Cells(4, col)
            col = col + 1
        Wend
 
        While diametre < Worksheets("Alesages").Cells(ligne, 1) Or diametre > Worksheets("Alesages").Cells(ligne, 2)
            ligne = ligne + 1
        Wend
 
        EI = CDbl(Replace(Worksheets("Alesages").Cells(ligne, col), "+D", ""))
 
    'Classe de J a ZC'
 
 
        'Valeur de Delta'
 
            If qualite = 3 Then
            colq = 38
            End If
 
            If qualite = 4 Then
            colq = 39
            End If
 
            If qualite = 5 Then
            colq = 40
            End If
 
            If qualite = 6 Then
            colq = 41
            End If
 
            If qualite = 7 Then
            colq = 42
            End If
 
            If qualite = 8 Then
            colq = 43
            End If
 
 
        If col >= 15 Then
 
            col = 15
            ligne = 6
 
            While classe <> Worksheets("Alesages").Cells(4, col)
                col = col + 1
            Wend
 
            While diametre < Worksheets("Alesages").Cells(ligne, 1) Or diametre > Worksheets("Alesages").Cells(ligne, 2)
                ligne = ligne + 1
            Wend
 
            If col = 15 Then
                col = 15 - 6 + qualite
            End If
 
            ES = CDbl(Replace(Worksheets("Alesages").Cells(ligne, col), "+D", ""))
 
            If col = 18 And qualite > 8 Then
                col = col + 1
            End If
 
             If col = 20 And qualite > 8 Then
                col = col + 1
            End If
 
             If col = 23 And qualite > 8 Then
                col = col + 1
            End If
 
If col = 18 Or col = 20 Or col = 23 Then
 
    With Worksheets("Alesages")
 
        ES = CDbl(Replace(.Cells(ligne, col), "+D", "")) + .Cells(ligne, colq)
 
    End With
 
End If
 
 
            If col >= 26 And qualite <= 7 Then
                ES = Worksheets("Alesages").Cells(ligne, col) + Worksheets("Alesages").Cells(ligne, colq)
            End If
 
            EI = ES - Worksheets("Ajustement").Cells(13, 9)
 
        End If
 
'Classe js'
 
        If col = 14 Then
            EI = -Val(Worksheets("Ajustement").Cells(13, 9)) / 2
        End If
 
'Résultat appliqué a la fonction'
 
    ALESAGE_EI = EI / 1000
 
End Function

Je commencerais par revoir les déclarations pour que toutes les variables soient définies par le type voulu.

Code:

1
2
    Dim ES As Double, EI As Double
    Dim col As Integer, ligne As Integer, colq As Integer

Ensuite, je remplacerais

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
            If qualite = 3 Then
            colq = 38
            End If
 
            If qualite = 4 Then
            colq = 39
            End If
 
            If qualite = 5 Then
            colq = 40
            End If
 
            If qualite = 6 Then
            colq = 41
            End If
 
            If qualite = 7 Then
            colq = 42
            End If
 
            If qualite = 8 Then
            colq = 43
            End If

par

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
        Select Case qualite
          Case 3
            colq = 38
          Case 4
            colq = 39
          Case Is = 5
            colq = 40
          Case 6
            colq = 41
          Case 7
            colq = 42
          Case Is = 8
            colq = 43
        End Select

en ajoutant un Case else.

04/01/2012, 17h09
ZebreLoup

Je pense qu'il faut même revoir plus en profondeur le code. Si tu nous expliques ce que tu veux calculer et comment ça se calcule (j'avoue que mes connaissances en mécaniques sont un peu loin), on pourra mieux t'aider.
04/01/2012, 18h14
Paro.

Pour faire court:

Un alésage correspond a un trou d'un certain diamètre dans une pièce, un arbre et un cylindre qui rentre dedans.
Au niveau mécanique d'usinage on a définie (H, JS, K, zc...) des classes avec lesquelles on obtient des diamètre compris entre deux valeurs extrêmement précise (écart supérieur, écart inférieur) (quand une usine un alésage ou arbre le but étant de d'obtenir un diamètre compris entre les deux valeur) selon des qualités (1 étant un qualité impossible a obtenir, 7 une qualité moyenne).
Tout ceci dans le but de prévoir le jeu maximum et le jeu minimum de l'arbre dans l'alésage.
Le jeu peu aussi bien être voulu négatif pour obtenir un assemblage serré que positif pour avoir un jeu possible.

Des tableaux on était définie, IT, Alésage, Arbre. Mes feuilles correspondent à ces tableaux.

La valeur de l'IT, intervalle de tolérance et défini en fonction du diamètre et de la qualité. Une fois l'IT obtenu on va voir la tableau des alésage et selon la classe on obtient, en fonction du diamètre de la classe et de plusieurs critère, soit l'écart supérieur soit l'écart inférieur. (Un écart supérieur tel que "-0.05" veut dire que le diamètre maxi à obtenir est "diamètre+écart supérieur. Si diamètre = 30 mm >>>> diamètre maxi=29.95). Et de même pour les arbres.

J'espère avoir été clair je sais que sait pas facile de comprend juste en lisant un petit paragraphe (de plus très mal écrit ^^).

Tout les If correspond au conditions étant débutant en VB je ne connai que ça. Que veut dire If exclusif?

A part ça le programme marche, j'ai vérifié avec des valeurs calculées à la main, je te remercie Zebreloup!
Pour faire plus propre j'attend donc vos conseil et je penser remplacer la "replace" par une "strings.instr" et une "strings.left", la .Instr chercherai le "+D" et la .Left permettrai de ne pas prendre en compte les deux dernier caractère pour le calcul (ici +D).

Pour l'histoire des deux colonnes, "col" correspond a la colonne ou se trouve la valeur finale (ES ou EI), et "colq" correspond a la colonne ou se trouve la valeur du delta (D) qu'il faut ajouter au résultat dans le cas de classe K M et N.

Désolé pour ce calvaire...

EDIT:
@defluc >> Je ne connais pas "case", il me semble, mais je me trompe surement, que ca ne pourrai marcher mais faudrai que tu m'explique un peu plus.
Sinon le fait de de dim une valeur a la fois change quoi?
04/01/2012, 18h47
ZebreLoup

Quand je parle des If exclusifs, c'est la structure

Code:

If ... ElseIf ... ElseIf ... Else ... End

Par exemple, tu calcules une première fois EI quelle que soit la colonne. Ensuite si on est en ES, tu l'écrases et donc ton premier calcul ne sert à rien. De même pour la classe js.
Ensuite, j'ai l'impression que tu ne gères pas les degrés de tolérance pour les ES, tu prends toujours la première colonne.
Enfin, tu ne gères pas le cas où l'on rentre un paramètre incorrect.

Pour ce qui est des degrés de tolérance pour les ES, le problème c'est qu'il va falloir faire du cas par cas si tu ne veux pas modifier la structure de ton onglet Alesage. Tu pourras utiliser par exemple Select Case

Bon voici se que j'ai fait, j'ai surtout essayé d'ordonner et de simplifier le code pour le rendre le plus compréhensible possible. J'ai également remplacé les If par des If exclusif et utilisé Select case (j'ai juste copié le code de defluc).

Enfin voila tout marche, c'est propre et c'est bien mieux!

Merci encore pour votre aide.

Si vous voyez d'autre chose qui pourrai être modifier dites moi, vu mes faibles connaissances il y en a surement ^^

Code:

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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
Option Explicit
Private Sub result_Click()
 
    diam12.Text = diam1.Text & " " & class1.Text & " " & qualite1.Text
 
    diam13.Text = diam1.Text & " " & class2.Text & " " & qualite2.Text
 
        Dim col1, col2, ligne1, ITal, ITab, D, Q1, Q2 As Integer
 
    D = Val(diam1.Text)
    Q1 = Val(qualite1.Text)
    Q2 = Val(qualite2.Text)
 
        With Worksheets("IT")
 
            col1 = 2 + Val(qualite1.Text)
            col2 = 2 + Val(qualite2.Text)
            ligne1 = 5
 
                While D < .Cells(ligne1, 1) Or D > .Cells(ligne1, 2)
                    ligne1 = ligne1 + 1
                Wend
 
            IT1.Value = .Cells(ligne1, col1)
            IT2.Value = .Cells(ligne1, col2)
            ITal = Val(IT1.Text)
            ITab = Val(IT2.Text)
 
        End With
 
    'ecarts alesage'
 
        Dim EIal, ESal As Double
        Dim colal, cold, ligneal As Byte
        Dim C1 As String
 
    colal = 3
    ligneal = 6
    C1 = class1.Text
 
        With Worksheets("alesages")
 
            'ecart inferieur'
 
                While D < .Cells(ligneal, 1) Or D > .Cells(ligneal, 2)
                    ligneal = ligneal + 1
                Wend
 
                While C1 <> .Cells(4, colal)
                    colal = colal + 1
                Wend
 
            EIal = CDbl(Replace(.Cells(ligneal, colal), "+D", ""))
 
                If colal = 14 Then
                    EIal = -(ITal / 2)
                End If
 
            'ecart superieur'
 
                Select Case Q1
                    Case 3
                        cold = 38
                    Case 4
                        cold = 39
                    Case Is = 5
                        cold = 40
                    Case 6
                        cold = 41
                    Case 7
                        cold = 42
                    Case Is = 8
                        cold = 43
                End Select
 
                If colal >= 15 Then
 
                colal = 15
                ligneal = 6
 
                    While C1 <> .Cells(4, colal)
                        colal = colal + 1
                    Wend
 
                    While D < .Cells(ligneal, 1) Or D > .Cells(ligneal, 2)
                        ligneal = ligneal + 1
                    Wend
 
                    If colal = 15 Then
                        colal = 15 - 6 + Q1
 
                        ESal = CDbl(Replace(.Cells(ligneal, colal), "+D", ""))
 
                    ElseIf colal = 18 And Q1 > 8 Then
                        colal = colal + 1
 
                    ElseIf colal = 20 And Q1 > 8 Then
                        colal = colal + 1
 
                    ElseIf colal = 23 And Q1 > 8 Then
                        colal = colal + 1
 
                    ElseIf colal = 18 Or colal = 20 Or colal = 23 Then
 
                        ESal = CDbl(Replace(.Cells(ligneal, colal), "+D", "")) + .Cells(ligneal, cold)
 
                    ElseIf colal >= 26 And Q1 <= 7 Then
                        ESal = (.Cells(ligneal, colal) + .Cells(ligneal, cold))
 
                    End If
 
                EIal = ESal - ITal
 
                End If
 
        End With
 
    ei1.Value = EIal
 
    'ecarts arbre'
 
        Dim ESab, EIab As Double
        Dim colab, ligneab As Integer
        Dim C2 As String
 
        With Worksheets("arbres")
 
        'ecart superieur'
 
        Q2 = Val(qualite2.Text)
        C2 = class2.Text
        colab = 3
        ligneab = 6
 
            While C2 <> .Cells(4, colab)
                colab = colab + 1
            Wend
 
            While D < .Cells(ligneab, 1) Or D > .Cells(ligneab, 2)
                ligneab = ligneab + 1
            Wend
 
        ESab = .Cells(ligneab, colab)
 
            If colab = 14 Then
                ESab = ITab / 2
            End If
 
        'ecart inferieur'
 
            If colab >= 15 Then
 
            colab = 15
            ligneab = 6
 
                While C2 <> .Cells(4, colab)
                    colab = colab + 1
                Wend
 
                While D < .Cells(ligneab, 1) Or D > .Cells(ligneab, 2)
                    ligneab = ligneab + 1
                Wend
 
                If colab = 15 And Q2 <> 5 Then
                    colab = 15 - 6 + Q2
 
                ElseIf colab = 15 And Q2 = 5 Then
                    colab = 15
 
                ElseIf colab = 19 And Q2 <= 3 Then
                    colab = colab + 1
 
                End If
 
            EIab = .Cells(ligneab, colab)
            ESab = EIab + ITab
 
            End If
 
        End With
 
    es2.Value = ESab
    es1.Value = EIal + ITal
    ei2.Value = ESab - ITab
 
    'Calcul des jeux MAXI et MINI
 
    jma.Value = (ESal - EIab) / 1000
    jmi.Value = (EIal - ESab) / 1000
 
End Sub

05/01/2012, 09h38
ZebreLoup

En survolant ton nouveau code (plus difficile à comprendre car je suppose que tu passes par un UserForm que nous ne connaissons pas), j'ai l'impression qu'il y a toujours quelques calculs inutiles, et surtout que tu ne gères toujours pas le couple Série/Degré de tolérance pour ceux où il y a un choix (J, K, M, N, P).

Bien vu!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 If colal = 15 Then
                        colal = 15 - 6 + Q1
                        ESal = CDbl(Replace(.Cells(ligneal, colal), "+D", ""))
 
                    ElseIf colal = 18 And Q1 > 8 Then
                        colal = colal + 1
                        ESal = CDbl(Replace(.Cells(ligneal, colal), "+D", ""))
 
                    ElseIf colal = 20 And Q1 > 8 Then
                        colal = colal + 1
                        ESal = CDbl(Replace(.Cells(ligneal, colal), "+D", ""))
 
                    ElseIf colal = 23 And Q1 > 8 Then
                        colal = colal + 1
                        ESal = CDbl(Replace(.Cells(ligneal, colal), "+D", ""))
 
                    ElseIf colal = 18 Or colal = 20 Or colal = 23 Then
                        ESal = CDbl(Replace(.Cells(ligneal, colal), "+D", "")) + .Cells(ligneal, cold)
 
                    ElseIf colal >= 26 And Q1 <= 7 Then
                        ESal = (.Cells(ligneal, colal) + .Cells(ligneal, cold))
 
                    End If

Mieux?
Pour les calculs inutiles, tu parle desquels?

J'ai refait un peu ton code (dans la version feuille, pas userForm, mais c'est très facilement adaptable vu que tu as les fonctions).
Essaie de décortiquer un peu tout ça, dis-moi ce que tu en penses, et pose-moi des question s'il y a des choses que tu ne comprends pas.

Code:

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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
Option Explicit
 
Private Enum TypeEcart
    EI
    ES
End Enum
 
'Un fonction générique pour trouver la ligne correspond à un diamètre
Private Function TrouverLigne(rg As Range, diametre As Double) As Integer
    'La plage doit être une plage de deux colonnes
    If rg.Columns.Count <> 2 Then Err.Raise 1234, "TrouverLigne", "Il faut chercher la ligne dans une plage de 2 colonnes"
 
    Dim i As Integer
 
    TrouverLigne = -1
 
    For i = 1 To rg.Rows.Count
        If diametre > rg.Cells(i, 1).Value And diametre <= rg.Cells(i, 2).Value Then
            TrouverLigne = i
            Exit For
        End If
    Next i
 
    'Si on n'a pas trouvé le diamètre on envoie une erreur
    If TrouverLigne = -1 Then Err.Raise 1234, "TrouverLigne", "diametre non trouvé dans cette plage"
 
End Function
 
'Calcul de la tolérance
Public Function CalculIT(diametre As Double, qualite As Byte) As Double
    Dim ws As Worksheet
    Dim ligne, col As Integer
 
    Set ws = Worksheets("IT") 'On va travailler sur la feuille IT
 
    ligne = 4 + TrouverLigne(ws.Range("A5:B25"), diametre) 'On cherche la bonne ligne
    col = 2 + qualite 'On cherche la colonne
 
    CalculIT = ws.Cells(ligne, col).Value 'On renvoie la valeur
 
End Function
 
'Calcul de l'alésage
Public Function Alesage(diametre As Double, classe As String, qualite As Byte) As Double
    Dim ws As Worksheet
    Dim ecart As Double
    Dim tEcart As TypeEcart
    Dim avecDelta As Boolean
    Dim ligne, col, colDelta As Integer
 
    Set ws = Worksheets("Alesages") 'On va travailler sur la feuille Alesages
 
    'On cherche la bonne ligne
    ligne = 5 + TrouverLigne(ws.Range("A6:B46"), diametre)
 
    'On cherche la colonne et les caractéristiques en fonction de la classe
    'Je ne sais pas si les cellules vides veulent dire 0 ou ce n'est pas possible, à modifier
    ' en fonction de ça. pour le moment, j'ai pris 0
    avecDelta = False
 
    Select Case classe
    Case "A", "B", "C", "CD", "D", "E", "EF", "F", "FG", "G", "H"
        col = ws.Range("C4:M4").Find(classe).Column
        tEcart = TypeEcart.EI
        ecart = ws.Cells(ligne, col).Value 'On récupère la valeur
    Case "JS"
        col = 14
        tEcart = TypeEcart.EI
        ecart = -(1 / 2) * CalculIT(diametre, qualite) 'Cas particulier
    Case "J"
        tEcart = TypeEcart.ES
        'En fonction de la qualite
        Select Case qualite
        Case 6, 7, 8
            col = 15 + qualite - 6
            ecart = ws.Cells(ligne, col).Value
        Case Else
            Err.Raise 1001, "Alesage", "Cette qualité n'est pas possible pour cette classe"
        End Select
    Case "K"
        tEcart = TypeEcart.ES
        If qualite <= 8 Then
            col = 18
            avecDelta = True
            ecart = CDbl(Replace(ws.Cells(ligne, col).Value, "+D", ""))
        Else
            ecart = 0
        End If
    Case "M"
        tEcart = TypeEcart.ES
        If qualite <= 8 Then
            col = 20
            avecDelta = True
            ecart = CDbl(Replace(ws.Cells(ligne, col).Value, "+D", ""))
        Else
            col = 21
            ecart = ws.Cells(ligne, col).Value
        End If
    Case "N"
        tEcart = TypeEcart.ES
        If qualite <= 8 Then
            col = 23
            avecDelta = True
            ecart = CDbl(Replace(ws.Cells(ligne, col).Value, "+D", ""))
        Else
            col = 24
            ecart = ws.Cells(ligne, col).Value
        End If
    Case "P"
        tEcart = TypeEcart.ES
        col = 26
        ecart = ws.Cells(ligne, col).Value
        If qualite <= 7 Then
            avecDelta = True
        End If
    Case "R", "S", "T", "U", "V", "X", "Y", "Z", "ZA", "ZB", "ZC"
        col = ws.Range("AA4:AK4").Find(classe).Column
        tEcart = TypeEcart.ES
        ecart = ws.Cells(ligne, col).Value
    Case Else
        Err.Raise 1001, "Alesage", "La classe fournie n'existe pas"
    End Select
 
    'S'il y a un Delta, on l'ajoute
    If avecDelta Then
        If qualite < 3 Or qualite > 8 Then Err.Raise 1001, "Alesage", "Pas de Delta pour cette qualité"
 
        colDelta = 38 + qualite - 3
        ecart = ecart + ws.Cells(ligne, colDelta).Value
    End If
 
    'On renvoie la valeur en fonction du type d'ecart
    If tEcart = TypeEcart.EI Then
        Alesage = ecart / 1000
    ElseIf tEcart = TypeEcart.ES Then
        Alesage = (ecart - CalculIT(diametre, qualite)) / 1000
    End If
 
End Function
 
'Calcul de l'arbre
Public Function Arbre(diametre As Double, classe As String, qualite As Byte) As Double
    Dim ws As Worksheet
    Dim rg As Range
    Dim ecart As Double
    Dim tEcart As TypeEcart
    Dim ligne, col As Integer
 
    Set ws = Worksheets("Arbres") 'On va travailler sur la feuille Arbres
 
    'On cherche la bonne ligne
    ligne = 5 + TrouverLigne(ws.Range("A6:B46"), diametre)
 
    'On cherche la colonne
    Set rg = ws.Range("C4:AH4").Find(classe)
 
    If rg Is Nothing Then Err.Raise 1001, "Arbre", "Classe non trouvée dans le tableau des arbres"
 
    If rg.Column <= 14 Then 'Ecart supérieur
        tEcart = TypeEcart.ES
 
        If rg.Column = 14 Then 'js
            ecart = CalculIT(diametre, qualite) / 2
        Else 'a-h
            ecart = ws.Cells(ligne, rg.Column).Value
        End If
    Else 'Ecart inférieur
        tEcart = TypeEcart.EI
 
        If rg.Column >= 21 Then 'm-zc
            ecart = ws.Cells(ligne, rg.Column).Value
        Else
            If classe = "j" Then 'j
                Select Case qualite
                Case 5, 6
                    col = 15
                Case 7
                    col = 16
                Case 8
                    col = 17
                Case Else
                    Err.Raise 1001, "Arbres", "Cette qualité n'est pas possible pour une classe j"
                End Select
                ecart = ws.Cells(ligne, col).Value
            ElseIf classe = "k" Then 'k
                If qualite >= 4 And qualite <= 7 Then
                    col = 19
                Else
                    col = 20
                End If
                ecart = ws.Cells(ligne, col).Value
            End If
        End If
    End If
 
    'On renvoie la valeur en fonction du type d'ecart
    If tEcart = TypeEcart.EI Then
        Arbre = (ecart + CalculIT(diametre, qualite)) / 1000
    ElseIf tEcart = TypeEcart.ES Then
        Arbre = ecart / 1000
    End If
 
End Function
 
'Fonctions d'étude des ajustements'
 
Public Function VALEUR_IT(diametre As Double, classe As String, qualite As Byte) As Variant
    'Je n'ai pas modifié, mais le paramètre classe ne sert à rien ici
    'J'ai fait une sous-fonction pour que tu puisses l'utiliser à partir d'un userForm ou comme formule
 
    On Error Resume Next
    VALEUR_IT = CalculIT(diametre, qualite)
    If Err.Number <> 0 Then VALEUR_IT = Err.Description 'En cas d'erreur, on affichera le message d'erreur dans la cellule
    On Error GoTo 0
End Function
 
Public Function ALESAGE_EI(diametre As Double, classe As String, qualite As Byte) As Variant
    On Error Resume Next
    ALESAGE_EI = Alesage(diametre, classe, qualite)
    If Err.Number <> 0 Then ALESAGE_EI = Err.Description 'En cas d'erreur, on affichera le message d'erreur dans la cellule
    On Error GoTo 0
End Function
 
Function ARBRE_ES(diametre As Double, classe As String, qualite As Byte) As Double
    On Error Resume Next
    ARBRE_ES = Arbre(diametre, classe, qualite)
    If Err.Number <> 0 Then ARBRE_ES = Err.Description 'En cas d'erreur, on affichera le message d'erreur dans la cellule
    On Error GoTo 0
End Function

05/01/2012, 11h49
Paro.

Que dire a part que c'est du super travail, merci beaucoup.
Je vais travailler dessus jusqu'à avoir compris l'utilité et le fonctionnement de chaque fonction, je viens de jeter un coup d'œil et j'ignore l'existence de la plupart..
C'est vraiment génial, je te poserai surement des questions alors merci d'avance, je m'y met de ce pas!
05/01/2012, 12h12
ZebreLoup

Tu sais, tout est très simple à part peut-être :

La fonction Find qui est l'équivalent d'un "Rechercher" par les menus ou en Ctrl+F.

La gestion des erreurs. Très basique ici, mais il y a de bons tutos sur ce site pour comprendre (et au pire, tu peux les virer si tu ne veux pas gérer les erreurs).

L'utilisation d'Enum qui ne servait qu'à rendre le code plus lisible. On aurait pu prendre un Byte pour le type et faire 0 ou 1 en se rappelant que 0 est EI et 1 est ES par exemple.
05/01/2012, 13h13
Paro.

Bon je viens de finir et je pense avoir a peu près tout compris, la fonction select case est super, enum pareil. maintenant je vais essayer de re écrire tout ca seul pour bien assimiler tout ca. Merci pour cet exelent travail, c'est surement pas grand chose pour toi mais ca l'est pour moi.

Enum peu prendre un nombre d'entité superieur a deux?

Oui, Enum peut avoir autant d'item que tu le désires. Tu peux également leur attribuer des valeurs pour les utiliser comme des entiers par exemple.
Code:

1 2 3 4 5 6 7 8 9 Enum JourSemaine Lundi = 1 Mardi = 2 Mercredi = 3 ... End Enum 'Et dans une procédure par exemple If DatePart("w", maDate, vbMonday) = JourSemaine.Mercredi Then ...

05/01/2012, 15h12
Paro.

C'est vachement cool de programmer des ptites macros finalement, j'ai bien fait de me pencher sur la question.

Je pense qu l'on peu estimer le problème résolu, merci pour tout!

Moi je vais aller bouffer du tuto ;)