Discussion :

[panda78]

bonjour,

dans ma fonction je vais chercher des valeurs dans une feuille pour faire mes calculs. Seulement voilà les valeurs en question sont nombreuses et j'aimerai pouvoir alléger ce code ci:

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
public function sigma(ByVal fc, ByVal L1, ByVal L2, ByRef plageSource As Range, ByVal nomFeuilDest As String) As SingleFor Each cellule In plageSource
f=cellule.value
 If cboChoixSrce.Text = "BRH" Then
        Lws = cellule.Offset(25, 4).Value
        Lwa = cellule.Offset(0, 4).value
       elseif cboChoixSrce.Text = "scie"
       Lws= cellule.Offset(25, 5).Value
       Lwa=cellule.Offset(0, 5).value
      elseif cboChoixSrce.Text = "compresseur"
       Lws= cellule.Offset(25, 6).Value
       Lwa=cellule.Offset(0, 6).value
      elseif cboChoixSrce.Text = "perceuse"
       Lws= cellule.Offset(25, 7).Value
       Lwa=cellule.Offset(0, 7).value
       elseif cboChoixSrce.Text = "marteau"
       Lws=   cellule.Offset(25, 8).Value
       Lwa=cellule.Offset(0, 8).value
 
           '..... etc
 end if
 
  ici mes calculs
 
        End If
end function
sub ray()
 Dim plageSource As Range
    Dim nomFeuilDest As String
    sigm=sigma(...)
    nomFeuilDest = "Feuil3"                     'on définit la feuille de destination
    Set plageSource = Range("Feuil1!B5:B25")
end sub

ça continue comme ça pour une trentaine de cboChoixSrce. peut on faire moins lourd?Merci

[mercatog]

Pour le début

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
Dim Trouve As Boolean
Dim Str As String
Dim c As Range
Dim i As Byte
Dim Typ
 
If cboChoixSrce.ListIndex > -1 Then
    Str = cboChoixSrce.Text
    Set c = PlageSource.Find(Str, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        Typ = Array("BRH", "SCIE", "COMPRESSEUR", "PERCEUSE")    '...etc
        For i = 0 To UBound(Typ)
            If UCase(Str) = Typ(i) Then
                Trouve = True
                Exit For
            End If
        Next i
        If Trouve Then
            Lws = c.Offset(25, 4 + i).Value
            Lwa = c.Offset(0, 4 + i).Value
        End If
        Set c = Nothing
    End If
    'suite
End If

[panda78]

Merci :-)

Bonjour,

en utilisant le code pour alléger les conditions, les resultats deviennent abbérant et je ne parviens pas à trouver "l'erreur" :
Voici ma function dans un module:

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
Public Function sigma(ByVal fc, ByVal L1, ByVal L2, ByRef plageSource As Range, ByVal nomFeuilDest As String) As Single
 
Dim Trouve As Boolean
Dim Str As String
Dim c As Range
Dim i As Byte
Dim Typ
 
for each c in PlageSource
f=c.value
 
   If cboChoixSrce.ListIndex > -1 Then
    Str = cboChoixSrce.Text
    Set c = plageSource.Find(Str, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        Typ = Array("Scie circulaire", "Marteau électrique", "Marteau pneumatique", "BRH", "BOBCAT", "BROKK", "Chute d'étais", _
        "Choc de marteau sur étais", "Perceuse", "Mini perceuse", "Chute de gravas", "Camion au ralentit", "Compresseur", _
        "Coulage plancher", "Aiguille vibrante", "Scie murale", "Frappe sur métal", "Hélicoptère", "Machine à enduire", _
        "Meuleuse", "Mini-pelle", "Perforateur", "Pince de démolition", "Pompe à béton", "Ponceuse plafond", _
        "Rangement d'étais", "Stop Net", "Toupie Béton Vidange")
        For i = 0 To UBound(Typ)
            If UCase(Str) = Typ(i) Then
                Trouve = True
                Exit For
            End If
        Next i
        If Trouve Then
            Lws = c.Offset(25, 1 + i).Value
            Lwa = c.Offset(0, 1 + i).Value
        End If
        Set c = Nothing
    End If
 
 
 
        sigma2 = 4 * L1 * L2 * ((f / c0) ^ 2)
        sigma3 = Sqr((2 * pi * f * (L1 + L2)) / (16 * c0))
        teta = teta0 + (Ms / (485 * Sqr(f)))
        Y = Sqr(f / fc)
 
 
 
  'Calcul de sigma
        If f11 <= (fc / 2) And f > fc Then ' => SI condition 1 validée ALORS
           sigma = 1 / Sqr(1 - (fc / f))
 
        ElseIf f11 <= (fc / 2) And f < fc And f > (fc / 2) Then  ' => SINON, SI condition 2 validée ALORS
           delta1 = ((1 - (Y ^ 2)) * Log(((1 + Y) / (1 - Y)) + (2 * Y))) / (4 * ((pi) ^ 2) * ((1 - (Y ^ 2)) ^ (1.5)))
           delta2 = 0
           sigma = (((2 * (L1 + L2) / (L1 * L2)) * (c0 / fc)) * delta1) + delta2
 
 'etc...
 
         end if
 
       epaisseur_equivalente = ThisWorkbook.Worksheets("Feuil3").Range("L28").Value
       If Lws = 0 Then
       Lwscorr = 0
       Lwas = 0
       Else
       Lwscorr = Lws - (20 * (Logd((epaisseur_equivalente) / 0.2)))
       End If
 
    'Calcul de Lwas et Lwatot
        If f < fc Then
 
          Lwas = Lwscorr - (10 * Logd(2 * pi * f * teta * Ms)) + 26 + (10 * Logd(sigma))
          Lwatot = 10 * Logd((10 ^ (0.1 * Lwas)) + (10 ^ (0.1 * Lwa)))
 
        ElseIf f = fc Then
 
          Lwas = Lwscorr - (10 * Logd(2 * pi * f * teta * Ms)) + 26 + (10 * Logd(sigma))
          Lwatot = 10 * Logd((10 ^ (0.1 * Lwas)) + (10 ^ (0.1 * Lwa)))
 
        ElseIf f > fc Then
 
          Lwas = Lwscorr - (10 * Logd(2 * pi * f * teta * Ms)) + 26 + (10 * Logd(sigma))
          Lwatot = 10 * Logd((10 ^ (0.1 * Lwas)) + (10 ^ (0.1 * Lwa)))
 
        End If
 
        J = J + 1
        Sheets(nomFeuilDest).Cells(J, 4).Value = sigma
        Sheets(nomFeuilDest).Cells(J, 6).Value = Lwas
        Sheets(nomFeuilDest).Cells(J, 7).Value = Lwatot
    End If     
    Next c
end function

Appel de 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
15
Sub rayonnement()
 
    Dim sgma As Variant
    Dim plageSource As Range
    Dim nomFeuilDest As String
 
    nomFeuilDest = "Feuil3"                     'on définit la feuille de destination
    Set plageSource = Range("Feuil1!B5:B25")    'on définit la plage source pour f
 
    sgma = sigma(fc, L1, L2, plageSource, nomFeuilDest)
 
   'désallocation
    Set plageSource = Nothing
 
End Sub

c'est dans la partie soulignée du code suivant que j'aimerai arriver à introduire toutes mes sources sans faire une tonne de lignes de condition if,

Au départ j'avais ceci:

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
Public Function sigma(ByVal fc, ByVal L1, ByVal L2, ByRef plageSource As Range, ByVal nomFeuilDest As String) As Single


  For Each cellule In plageSource 

        f = cellule.Value
        If UserForm1.cboChoixSrce.Text = "BRH" Then
        Lws = cellule.Offset(25, 4).Value
        Lwa = cellule.Offset(0, 4).Value
        End If       

        sigma2 = 4 * L1 * L2 * ((f / c0) ^ 2)
        sigma3 = Sqr((2 * pi * f * (L1 + L2)) / (16 * c0))
        teta = teta0 + (Ms / (485 * Sqr(f)))
        Y = Sqr(f / fc)
      
        epaisseur_equivalente = ThisWorkbook.Worksheets("Feuil3").Range("L28").Value
        Lwscorr = Lws - (20 * (Logd((epaisseur_equivalente) / 0.2)))
        
  'Calcul de sigma
        If f11 <= (fc / 2) And f > fc Then ' => SI condition 1 validée ALORS
           sigma = 1 / Sqr(1 - (fc / f))
           
        ElseIf f11 <= (fc / 2) And f < fc And f > (fc / 2) Then          
              'etc.....
         End If
        
       
        
    'Calcul de Lwas et Lwatot
        If f < fc Then
          
          Lwas = Lwscorr - (10 * Logd(2 * pi * f * teta * Ms)) + 26 + (10 * Logd(sigma))
          Lwatot = 10 * Logd((10 ^ (0.1 * Lwas)) + (10 ^ (0.1 * Lwa)))
             
        ElseIf f = fc Then
        
          Lwas = Lwscorr - (10 * Logd(2 * pi * f * teta * Ms)) + 26 + (10 * Logd(sigma))
          Lwatot = 10 * Logd((10 ^ (0.1 * Lwas)) + (10 ^ (0.1 * Lwa)))
    
        ElseIf f > fc Then
        
          Lwas = Lwscorr - (10 * Logd(2 * pi * f * teta * Ms)) + 26 + (10 * Logd(sigma))
          Lwatot = 10 * Logd((10 ^ (0.1 * Lwas)) + (10 ^ (0.1 * Lwa)))
             
        End If
                     
        J = J + 1
        Sheets(nomFeuilDest).Cells(J, 4).Value = sigma
        Sheets(nomFeuilDest).Cells(J, 6).Value = Lwas
        Sheets(nomFeuilDest).Cells(J, 7).Value = Lwatot
             
    Next cellule
 
    For i = 1 To 10
        If Sheets(nomFeuilDest).Cells(i, 4).Value = "" Then Cells(i, 4).Value = " Sigma"
        If Sheets(nomFeuilDest).Cells(i, 6).Value = "" Then Cells(i, 6).Value = " Lwas"
        If Sheets(nomFeuilDest).Cells(i, 7).Value = "" Then Cells(i, 7).Value = " Lwatot"
        
    Next i
 
    'Désallocation mémoire
    Set cellule = Nothing
    
End Function

[mercatog]

Soit tu n'étudie pas assez les codes qu'on te propose, soit les propositions ne sont pas assez claires et compréhensibles.

La ligne 22 suggère la comparaison de 2 mots en majuscule, avec dans Typ, tous les mots en majuscule.

Sinon, comme tu l'as écris, remplace la ligne 22 par celle-ci

Code :

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

                If Str = Typ(i) Then

Pour le test et seulement pour tester, ajoute cette ligne juste après la ligne 29

Code :

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

MsgBox "i: " & i & ",  Lws: " & Lws & ", Lwa: " & Lwa

Cette ligne sera supprimé quand tou fonctionne comme souhaité.


PSlus tard quand tu auras fais marcher le code comme souhaité, on va changer le tableau Typ où on a écrits les différents types en dur dans le code, par une plage de données dynamique sur ta feuille Config

[mercatog]

Quand tu écris

Code :

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

1
2
3
4
5
Typ = Array("Scie circulaire", "Marteau électrique", "Marteau pneumatique", "BRH", "BOBCAT", "BROKK", "Chute d'étais", _
        "Choc de marteau sur étais", "Perceuse", "Mini perceuse", "Chute de gravas", "Camion au ralentit", "Compresseur", _
        "Coulage plancher", "Aiguille vibrante", "Scie murale", "Frappe sur métal", "Hélicoptère", "Machine à enduire", _
        "Meuleuse", "Mini-pelle", "Perforateur", "Pince de démolition", "Pompe à béton", "Ponceuse plafond", _
        "Rangement d'étais", "Stop Net", "Toupie Béton Vidange")

Et si ta PlageSource est B5:B25
Avec ces lignes:

Code :

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

1
2
                lws = c.Offset(25, 1 + i).Value
                lwa = c.Offset(0, 1 + i).Value

Tu auras Scie circulaire en colonne C, Marteau électrique en colonne D...etc (par ordre de ton tableau Typ)

[panda78]

Oui exactement!

J'ai compris le code mais les résultats deviennent faux et j'arrive pas à voir où ça clocle. Le code donne des valeurs de Lwas et donc de Lwatot totalement fausses en revanche les sigma sont bons...

[mercatog]

C'est normal que ton tableau comporte 28 items alors que plageSource 21?
Tu as fais le pas à pas pour voir les résultats intermédiaires obtenus?


Tu cherche le Type dans B5:B25 et tu décale en bas de 25 lignes et à gauche de n colonnes (en fonction du type) pour récupérer la valeur du Lws souhaité