Calcul avec tableaux internes au code vba

**mignane** · 15/07/2012, 13h35

Bonjour,
Je dispose de 2 tableaux (interne au code):
- réponse (n1 lignes, n2 colonnes): les colonnes représentent le nbre de signaux étudiés et les lignes décrivent la réponse de chaque signal dans le domaine fréquentiel
- fréquence (n1 lignes)
Pour chaque colonne j ( réponse du signal j) je dois calculer le moment d'ordre 0 et le stocker dans un tableau moment de n2 colonnes.
si i désigne l'indice de la ligne et j l'indice de la colonne:
pour la colonne j du tableau moment (m(j)) on a:
m(j) = somme( [frequence (i) -frequence (i-1)]*[Réponse (i,j)+Réponse(i-1,j)]/2
j'ai donc fait ce bout de code:

Code :

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

1
2
3
4
5
6
        For j = 1 To UBound(Response, 2)
        ReDim Preserve m_0(j)
        For i = 2 To UBound(Response, 1)
        m_0(j) = m_0(j) + (freq(i) - freq(i - 1)) * (Response(i, j) + Response(i - 1, j)) / 2
        Next i
        Next j

Lorsque j'affiche le résultat sur une feuille, seul le moment de la première colonne est juste. Tout le reste est faux.
Quelqu'un pourrait-il me donner un coup de main pour voir ce qui est faux dans mon code

**mercatog** · 15/07/2012, 13h40

Mets ton code en entier, ça sera plus lisible et compréhensible

**mignane** · 15/07/2012, 15h44

Voici mon code (je suis débutant donc c vraiment un code de vrai débutant

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
 
Sub Test ()
    Dim Plagex As Range
    Dim Plagey As Range
    Set Plagex = Application.InputBox("Sélectionnez la plage x (fréquence TRF) ", "Sélection de cellules", Type:=8)
    Set Plagey = Application.InputBox("Sélectionnez une plage y (TRF) ", "Sélection de cellules", Type:=8)
    Dim NbLig As Long, i As Long
    Dim Tot As Double
    Dim x, y As TextFrame
    Dim Tb, Res(), freq(), Snn(), TRF(), Response(), m_0()
    Dim TRF_inp, freq_inp As Range
    Dim v1, v2, p, g, nf As Double, ip, N1, N2 As Integer
    Application.ScreenUpdating = False
    With Worksheets("Input")
        NbLig = .Range("C4").End(xlDown).Row
        NbCol = .Range("D3").End(xlToRight).Column
        Tb = .Range(.Cells(3, 3), .Cells(NbLig, NbCol))
        Tot = Application.Sum(.Range(.Cells(4, 4), .Cells(NbLig, NbCol)))
        v1 = 0.0333
        v2 = 0.25
        nf = 100
        p = v2 / nf
        g = 7
    End With
 '
    For i = 2 To UBound(Tb, 1)
        For j = 2 To UBound(Tb, 2)
            If Tb(i, j) <> "" Then
                k = k + 1
                ReDim Preserve Res(1 To 3, 1 To k)
                Res(1, k) = Tb(i, 1)
                Res(2, k) = Tb(1, j)
                Res(3, k) = Format(Tb(i, j) / Tot, "0.0000%")
            End If
        Next j
    Next i
    '*********************************************************************
    ' Définition de la plage de fréquences d'étude
    For i = 1 To nf
        ReDim Preserve freq(i)
        freq(i) = i * p
        Next i
        With Worksheets("Feuil3")
             .Range("B2").Resize(i) = Application.Transpose(freq)
        End With
    '***************************************************************************
    'Définition du spectre  (fonction "entrée")
    With Worksheets("Feuil3")
        For i = 1 To UBound(Res, 2)
        For j = 1 To UBound(freq, 1)
            ReDim Preserve Snn(UBound(Res, 2), j)
            Snn(i, j) = Spectre(Res(1, i), Res(2, i), g, freq(j))
            .Cells(2 + j, 2 + i) = Format(Snn(i, j), "0.000") 'ligne permettant d'afficher les spectres
            Next j
        Next i
    End With
    '*************************************************************************
    'Définition de la fonction de transfert
       With Worksheets("Feuil2")
        For i = 1 To UBound(freq, 1)
            ReDim Preserve TRF(i)
            If freq(i) >= v1 Then
                TRF(i) = Interpol(Plagex, Plagey, freq(i))
          Else
                TRF(i) = 0
            End If
            .Cells(2 + i, 2) = freq(i)
            .Cells(2 + i, 3) = TRF(i)
        Next i
    End With
    '****************************************************************************
    'Calcul de la Réponse spectrale = TRF^2*Snn
    With Worksheets("Feuil4")
        For j = 1 To UBound(TRF, 1)
        For i = 1 To UBound(Snn, 1)
        ReDim Preserve Response(UBound(TRF, 1), i)
        Response(j, i) = Spectre(Res(1, i), Res(2, i), g, freq(j)) * (TRF(j)) ^ 2
        .Cells(2 + j, 2 + i) = Response(j, i)
       Next i
       Next j
    End With
    '****************************************************************************
    'Calcul du moment d'ordre 0: m0
       With Worksheets("Feuil5")
        For j = 1 To UBound(Response, 2)
        ReDim Preserve m_0(j)
        For i = 2 To UBound(Response, 1)
        m_0(j) = m_0(j) + (freq(i) - freq(i - 1)) * (Response(i, j) + Response(i - 1, j)) / 2
        Next i
       .Cells(2, 2 + j) = m_0(j)
        Next j
      End With
End Sub

**mercatog** · 15/07/2012, 16h25

Désolé, j'aurai besoin d'un exemple de fichier fidèle pour pouvoir tester ton code

**mignane** · 15/07/2012, 17h05

Ci-joint mon fichier. Si vous avez des idées pour optimiser je suis preneur.

**mercatog** · 15/07/2012, 19h24

J'ai remodelé tes codes de façon à:
1. déclarer convenablement les variables
2. Tirer l'utilité des variables tableau (dans le sens ou l'injection directe du tableau avec un redimensionnement adéquat) Je te laisse le choix de comparer les 2 codes:

En fin de compte, je ne saurai me prononcer sur l'exactitude des résultats

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
144
145
146
147
148
149
150
151
152
153
Option Explicit
 
Sub Spectralfatigue()
Dim Res() As Double, Freq() As Double, Snn() As Double, TRF() As Double, Response() As Double, M0() As Double
Dim V1 As Double, V2 As Double, P As Double, G As Double, Nf As Double, Tot As Double
Dim NbLig As Long, i As Long, j As Long, k As Long
Dim PlageX As Range, PlageY As Range
Dim NbCol As Integer
Dim Tb
 
'pour gérer l'annulation
On Error Resume Next
Set PlageX = Application.InputBox("Sélectionnez la plage x (fréquence TRF) ", "Sélection de cellules", Type:=8)
Set PlageY = Application.InputBox("Sélectionnez une plage y (TRF) ", "Sélection de cellules", Type:=8)
On Error GoTo 0
Application.ScreenUpdating = False
'*********************************************************************
'
If Not PlageX Is Nothing And Not PlageY Is Nothing Then
    With Worksheets("Input")
        NbLig = .Range("C4").End(xlDown).Row
        NbCol = .Range("D3").End(xlToRight).Column
        Tb = .Range(.Cells(3, 3), .Cells(NbLig, NbCol))
        Tot = Application.Sum(.Range(.Cells(4, 4), .Cells(NbLig, NbCol)))
        V1 = 0.0333
        V2 = 0.25
        Nf = 100
        P = V2 / Nf
        G = 7
    End With
    '*********************************************************************
    '
    For i = 2 To UBound(Tb, 1)
        For j = 2 To UBound(Tb, 2)
            If Tb(i, j) <> "" Then
                k = k + 1
                ReDim Preserve Res(1 To 3, 1 To k)
                Res(1, k) = Tb(i, 1)
                Res(2, k) = Tb(1, j)
                Res(3, k) = Tb(i, j) / Tot
            End If
        Next j
    Next i
 
    '*********************************************************************
    ' Définition de la plage de fréquences d'étude
    ReDim Freq(1 To Nf, 1 To 1)
    For i = 1 To Nf
        Freq(i, 1) = i * P
    Next i
    Worksheets("Feuil3").Range("B2").Resize(Nf, 1) = Freq
 
    '***************************************************************************
    'Définition du spectre de la fonction "entrée"
    ReDim Snn(1 To k, 1 To Nf)
 
    For i = 1 To k
        For j = 1 To Nf
            Snn(i, j) = Spectre(Res(1, i), Res(2, i), G, Freq(j, 1))
        Next j
    Next i
 
    With Worksheets("Feuil3").Range("C2").Resize(Nf, k)
        .Value = Application.Transpose(Snn)        'ligne permettant d'afficher les spectres
        .NumberFormat = "0.000"
    End With
 
    '*************************************************************************
    'Définition de la fonction de transfert
    ReDim TRF(1 To Nf, 1 To 1)
 
    For i = 1 To Nf
        If Freq(i, 1) >= V1 Then TRF(i, 1) = Interpol(PlageX, PlageY, Freq(i, 1))
    Next i
    With Worksheets("Feuil2")
        .Range("B3").Resize(Nf, 1) = Freq
        .Range("C3").Resize(Nf, 1) = TRF
    End With
 
    '****************************************************************************
    'Calcul de la Réponse spectrale = TRF^2*Snn
    ReDim Response(1 To Nf, 1 To k)
    For j = 1 To Nf
        For i = 1 To k
            Response(j, i) = Spectre(Res(1, i), Res(2, i), G, Freq(j, 1)) * (TRF(j, 1)) ^ 2
        Next i
    Next j
    Worksheets("Feuil4").Range("C2").Resize(Nf, k) = Response
 
    '****************************************************************************
    'Calcul du moment d'ordre 0: m0
    ReDim M0(1 To 1, 1 To k)
 
    For j = 1 To k
        For i = 2 To Nf
            M0(1, j) = M0(1, j) + (Freq(i, 1) - Freq(i - 1, 1)) * (Response(i, j) + Response(i - 1, j)) / 2
        Next i
    Next j
    Worksheets("Feuil5").Range("C2").Resize(1, k) = M0
    MsgBox "Traitement terminé...."
End If
 
End Sub
 
 
Function Spectre(ByVal X As Double, ByVal Y As Double, ByVal Z As Double, ByVal F As Double) As Double
Dim Fp As Double, a As Double, c As Double, Sigm As Double
 
Fp = 1 / Y
c = 1 / (1 - 0.287 * Log(Z))
a = 5 / (16 * c)
Sigm = IIf(Fp < F, 0.07, 0.09)
Spectre = a * X ^ 2 * Y * (F / Fp) ^ (-5) * Exp(-1.25 * (F / Fp) ^ (-4)) * Z ^ (Exp(-((F / Fp - 1) ^ 2 / (2 * Sigm ^ 2))))
End Function
 
 
Function Interpol(ByVal X As Range, ByVal Y As Range, ByVal X2 As Double) As Double
Dim i As Long, j As Long, m As Long
Dim X3() As Double, Y3() As Double
'
'This function is for interpolation. You choose a range with the independant
'variable first, then a range (same number of columns and rows as the first one)
'with your data and for the last component, you choose a value from your first
'range (independant variable). And you copy-paste your formula.
'
'Si les ranges sont différents, alors la formule ne marche pas
If X.Count = Y.Count Then
    'On compte le nombre de données (j) dans la colonne à interpoler sur un total
    'de (i) données. S'il n'y a pas de données dans la colonne à interpoler, la
    'fonction retourne 0
    j = Application.CountA(Y)
    If j > 0 Then
        'On compte maintenant le nombre de données à interpoler et leur emplacement par
        'rapport au nombre de données total qu'on veut, d'où X3 et Y3.
        ReDim X3(j)
        ReDim Y3(j)
        m = j
        j = 1
        For i = 1 To Y.Count
            If Y(i) <> "" Then
                X3(j) = X(i)
                Y3(j) = Y(i)
                j = j + 1
            End If
        Next i
        For j = 2 To m
            If X2 <= X3(j) Then Exit For
        Next j
        If j = m + 1 Then j = m
        Interpol = Y3(j - 1) + (Y3(j) - Y3(j - 1)) * (X2 - X3(j - 1)) / (X3(j) - X3(j - 1))
    End If
End If
End Function

Calcul avec tableaux internes au code vba

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager