[XL-2010] Probème avec strings.replace

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

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!

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.

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 ...

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 ;)