Remplir une matrice en VBA

[Benjo]

Salut à tous

Je vous explique deja le contexte:
J'ai une feuille excel.
Colonne A des dates,
colonne B des chiffres (qui correspondent à des cours d'action, mais peut importe)

Je dois donc déclarer une matrice qui devra stocker le résultat de la formule suivante : (cours date t - cours date t-1)/ cours date t-1

et ainsi de suite pour toutes les dates (donc toutes les lignes)

Je ne sais pas comment remplir ma matrice.

Je ne sais pas si j'ai été tres clair... mais n'hésitez pas à me demander des précisions.

E:

Matrix

Option Base 0

Sub main()
    
    Dim matrixA() As Integer
    Dim matrixB() As Integer
    Dim nb_execussions As Integer
    Dim average_time As Double
    Dim start_time As Double
    Dim i As Integer
    
    Worksheets("matrix").Activate
    nb_execussions = 10000
    matrixA = load_matrix()
    
    start_time = Timer
    For i = 1 To nb_execussions
        matrixB = get_cumulative_matrix(matrixA)
    Next i
    average_time = (Timer - start_time) / nb_execussions
    
    Range(Cells(2, 13), Cells(11, 22)).Value2 = matrixB
    Range("T13") = average_time

End Sub

Function load_matrix()
    
    Dim nb_rows, i, j As Integer
    Dim matrix() As Integer
    
    nb_rows = Range("B2").End(xlDown).Row - 1
    ReDim matrix(nb_rows - 1, nb_rows - 1)
    
    For i = 1 To nb_rows
        For j = 1 To nb_rows
            matrix(i - 1, j - 1) = Cells(i + 1, j + 1)
        Next j
    Next i
    
    load_matrix = matrix
    
End Function

Function get_cumulative_matrix(matrix)
    
    Dim nb_rows, i, j, k, l As Integer
    Dim sum As Double
    Dim cumulative_matrix() As Integer
    
    nb_rows = UBound(matrix)
    ReDim cumulative_matrix(nb_rows, nb_rows)
    
    For i = 0 To nb_rows
        For j = i To nb_rows
            sum = 0
            
            For k = j To nb_rows
                For l = i To 0 Step -1
                    sum = sum + matrix(l, k)
                Next l
            Next k
            
            cumulative_matrix(i, j) = sum
            cumulative_matrix(j, i) = sum
        Next j
    Next i
    
    get_cumulative_matrix = cumulative_matrix

End Function

Bollinger

Sub main()

    Dim mm As Integer
    Dim derniere_ligne As Integer
    
    mm = 20
    
    Worksheets("bollinger").Activate
    derniere_ligne = Range("A1").End(xlDown).Row
    Range(Cells(2, 3), Cells(derniere_ligne, 5)).ClearContents
    Range(Cells(mm + 1, 3), Cells(derniere_ligne, 3)).FormulaR1C1 = "=AVERAGE(R[" & -mm + 1 & "]C2:RC2)"
    Range(Cells(mm + 1, 4), Cells(derniere_ligne, 4)).FormulaR1C1 = "=RC3 - 2 * STDEV(R[" & -mm + 1 & "]C2:RC2)"
    Range(Cells(mm + 1, 5), Cells(derniere_ligne, 5)).FormulaR1C1 = "=RC3 + 2 * STDEV(R[" & -mm + 1 & "]C2:RC2)"

End Sub

Factorielle

Function factorielle(n)
    
    If n = 1 Then
        factorielle = 1
    Else
        factorielle = n * factorielle(n - 1)
    End If
    
End Function

Spot

Sub main()
    
    Dim my_spot As spot
    Dim nb_periods, i As Integer
    
    Worksheets("spots").Activate
    Cells.ClearFormats
    nb_periods = 250
    
    For i = 1 To 5
        Set my_spot = New spot
        my_spot.run (nb_periods)
    Next i

End Sub

Classe spot:

Private x_, y_, color_ As Integer

Sub run(nb_periods)

For i = 1 To nb_periods
Call next_step
Cells(x_, y_).Interior.ColorIndex = color_
Next i

End Sub

Private Sub next_step()

Randomize
If Rnd() > 0.5 Then
x_ = x_ + 1
Else
x_ = x_ - 1
End If
y_ = y_ + 1

End Sub

Private Sub Class_Initialize()
x_ = 100
y_ = 1
color_ = Int(10 + Rnd() * 50)
Cells(x_, y_).Interior.ColorIndex = color_
End Sub

 

[Benjo]

Re : Remplir une matrice en VBA

Ha oui, je précise quand meme que chaque ligne correponds à une date différente, et donc un cours différent.
@++




T:

Divers

Option Base 1

Sub main()
        
    matrix_covar = get_matrix_covar()
    total_stocks = UBound(matrix_covar)
    Worksheets("Diversification").Activate
        
    For nb_stocks = 1 To 25
        
        weight = 1 / nb_stocks
        
        For num_simulation = 1 To 30
        
            ReDim weights(1, total_stocks) As Double
            expected_nb_stocks = 0
        
            Do
                num_titre = Int(Rnd() * total_stocks) + 1
                If weights(1, num_titre) = 0 Then
                    weights(1, num_titre) = weight
                    expected_nb_stocks = expected_nb_stocks + 1
                End If
            Loop Until expected_nb_stocks = nb_stocks
    
            Var = WorksheetFunction.MMult(WorksheetFunction.MMult(weights, matrix_covar), WorksheetFunction.Transpose(weights))
            Cells(nb_stocks + 1, num_simulation + 1) = Var(1)
                
        Next num_simulation
    Next nb_stocks
    
End Sub

Function get_matrix_covar()
    
    Dim matrix_covar() As Double
    Dim sheet As Worksheet
    Dim Yields1, Yields2 As Range
    Dim i, j, LastRow, nb_stocks As Integer
    
    Set sheet = Worksheets("Titres")
    last_row = sheet.Range("a1").End(xlDown).Row
    nb_stocks = sheet.Range("a1").End(xlToRight).Column - 1
    ReDim matrix_covar(nb_stocks, nb_stocks)
    
    For i = 1 To nb_stocks
        Set Yields1 = sheet.Range(sheet.Cells(2, i + 1), sheet.Cells(last_row, i + 1))
        For j = i To nb_stocks
            Set Yields2 = sheet.Range(sheet.Cells(2, j + 1), sheet.Cells(last_row, j + 1))
            matrix_covar(i, j) = WorksheetFunction.Covar(Yields1, Yields2)
            matrix_covar(j, i) = matrix_covar(i, j)
        Next j
    Next i
    
    get_matrix_covar = matrix_covar
    
End Function

Tri

Sub display_tree()
    
    Dim S0, u, d As Double
    Dim nb_periods, num_period, n As Integer
    
    S0 = 100
    u = 1.1
    d = 1 / u
    nb_periods = 50
    Cells.ClearContents
    
    For num_period = 0 To nb_periods
        first_row = nb_periods - num_period + 1
        slice = get_slice(S0, u, d, num_period)
        
        For n = 0 To num_period
            Cells(first_row + 2 * n, num_period + 1) = slice(n)
        Next n
    Next num_period

End Sub

Sub test_crr()
    call_eur = get_crr_price(100, 105, 1, 0.1, 0.05, 12, True, True)
    put_eur = get_crr_price(100, 105, 1, 0.1, 0.05, 12, False, True)
    call_us = get_crr_price(100, 105, 1, 0.1, 0.05, 12, True, False)
    put_us = get_crr_price(100, 105, 1, 0.1, 0.05, 12, False, False)
End Sub

Function get_crr_price(S0, strike, maturity, sigma, r, nb_periods, is_call As Boolean, is_european As Boolean)
    
    Dim price As Double
    
    dt = maturity / nb_periods
    u = Exp(sigma * Sqr(dt))
    d = 1 / u
    p = (Exp(r * dt) - d) / (u - d)
            
    z = IIf(is_call, 1, -1)
    prices = get_payoffs(S0, u, d, nb_periods, strike, z)
    
    For t = nb_periods - 1 To 0 Step -1
        
        If is_european Then
            For n = 0 To t
                prices(n) = Exp(-r * dt) * (p * prices(n) + (1 - p) * prices(n + 1))
            Next n
        Else
            payoffs = get_payoffs(S0, u, d, t, strike, z)
            For n = 0 To t
                price = Exp(-r * dt) * (p * prices(n) + (1 - p) * prices(n + 1))
                prices(n) = WorksheetFunction.Max(payoffs(n), price)
            Next n
        End If
    Next t
    
    get_crr_price = prices(0)
    
End Function

Function get_slice(S0, u, d, num_period)

    Dim slice() As Double
    ReDim slice(num_period)

    For t = 0 To num_period
        slice(t) = S0 * d ^ t * u ^ (num_period - t)
    Next t
    
    get_slice = slice

End Function

Function get_payoffs(S0, u, d, num_period, strike, z)

    Dim payoffs() As Double
    Dim underlying As Double
    ReDim payoffs(num_period)

    For t = 0 To num_period
        underlying = S0 * d ^ t * u ^ (num_period - t)
        payoffs(t) = WorksheetFunction.Max(z * (underlying - strike), 0)
    Next t
    
    get_payoffs = payoffs

End Function

bal

Public Const FIRST_FLOOR = 50
Public Const SECOND_FLOOR = 100
Public Const START_COLUMN = 100
Private Const NB_BALLS = 300


Sub multiballs()

    Dim b As Ball
    Dim balls As Collection

    Set balls = New Collection
    added_balls = 0

    Cells.ClearFormats
    Cells.ClearContents

    Do
        If added_balls <= NB_BALLS Then
            Set b = New Ball
            b.name = Str(added_balls)
            balls.Add Item:=b, key:=b.name
            added_balls = added_balls + 1
        End If
        
        For Each b In balls
            If b.is_placed Then
                balls.Remove (b.name)
            Else
                b.fall
            End If
        Next b
                    
    Loop Until balls.count = 0

End Sub

classe bal

Public is_placed As Boolean
Public name As String

Private x_ As Integer
Private y_ As Integer

Public Sub fall()
    
    Cells(x_, y_).Interior.ColorIndex = 2
    Call new_position
    Cells(x_, y_).Interior.ColorIndex = 3
    
    If x_ >= FIRST_FLOOR Then
        is_placed = True
        For i = x_ + 1 To SECOND_FLOOR
            If Cells(i, y_).Interior.ColorIndex <> 3 Then
                is_placed = False
            End If
        Next i
    End If
        
End Sub

Public Sub show_name()
    Cells(x_, y_).Value = name
End Sub

Private Function new_position()
    x_ = x_ + 1

    If x_ < FIRST_FLOOR Then
        Randomize
        If Rnd > 0.5 Then
            y_ = y_ + 1
        Else
            y_ = y_ - 1
        End If
    End If
    
End Function


Private Sub Class_Initialize()
    x_ = 1
    y_ = START_COLUMN
    is_placed = False
    Cells(x_, y_).Interior.ColorIndex = 3
End Sub

 

[Benjo]

Re : Remplir une matrice en VBA

En fait, j'ai plus ou moins reussi ce que je voulais faire...
en revanche, je bloque sur un point:
Je voudrais que le calcul ne se fasse pas toutes les 10 lignes.
C'est à dire que chaque fois que j'arrive sur la ligne 10, 20, 30 etc. ca saute cette cellule et ca passe à celle du dessous.

Sachant que j'ai une boucle for i = 1 to nombre (nombre prend la valeur 100), je peux utiliser un step ?

Merci beaucoup de votre aide
@++

 

[Excel-lent]

Re : Remplir une matrice en VBA

Bonsoir Benjo,

Oui tu peux utiliser un "step" mais je ne vois pas comment tu veux l'utiliser!

Sinon tu peux faire ainsi

For dizaine = 0 To ...
    For unité = 1 To 9
       ....
    Next unité
Next dizaine

Ainsi ton numéro de ligne sera : dizaine*10 + unité que tu pourras utiliser à l'intérieur de ta boucle

Ou sinon :

For ligne = 1 To [A65536].End(xlUp).Row
     If ligne/10 - ENT(ligne/10) <> 0 Then
       ....
Next ligne

Peux pas dire mieux avec une question si générale.

Cela répond à ta question? Si tu as besoin d'une réponse plus précise, soit plus précis dans ta question un p'tit fichier simplifié et nettoyé de tt info. personnelles.

A te lire

Cordialement

 

[Benjo]

Re : Remplir une matrice en VBA

Ha oui, pas bete du tout !
Merci beaucoup,

Je vais reflechir dans ce sens et revenir te confirmer que ca marche
@++

 

[Cousinhub]

Re : Remplir une matrice en VBA

Bonjour,

une autre approche :

For i = 1 To 100
    If i Mod 10 <> 0 Then Cells(i, 1) = i
Next i

 

[Benjo]

Re : Remplir une matrice en VBA

En fait, j'ai essayé en m'inspirant de ton idée.

Le programme vérifie si le résultat de la division "numéro de la ligne / 10" est un entier.
Si c'est le cas, ca saute le calcul de rentabilité.

J'aii essayé de faire ca a partir d'un

i = 1
For j = 4 To 120

If (j - 2) Mod "10" = "0" Then   'j étant le numéro de la ligne, et - 2 car c'est toutes les 10 lignes à parti de la 2 qu'on saute le calcul
i = i
Else
i = i + 1
End If
Matrice_Variations(i, 1) = (Cells(i + 3, 2).Value - Cells(i + 2, 2).Value) / Cells(i + 2, 2).Value

Mais ca ne marche pas.
J'ai l'impression que c'est le MOD qui ne fonctionne pas.
Une idée ?

Merci beaucoup de votre aide
@++

 

[Benjo]

Re : Remplir une matrice en VBA

Précision:
Ca ne fonctionne pas non plus avec

If (j - 2) Mod 10 = 0

c'est à dire sans les guillements.

 

[Benjo]

Re : Remplir une matrice en VBA

J'ai reussi à faire le test, ca fonctionne avec ta methode (INT())
mais je n'arrive pas à comprendre pourquoi le resultat final n'est pas celui attendu....

i = 0
For j = 3 To 120

If (j - 2) / 10 - Int((j - 2) / 10) = "0" Then
i = i

Else
i = i + 1

End If

Matrice_Variations(i, 1) = Cells(j, 2).Value 'pour le moment je vois si ca fonctionne avec un simple copie colle de cellule


Next
Worksheets("Agreg2").Activate
For i = 1 To 120
Cells(i, 1).Value = Matrice_Variations(i, 1)
Next
End Sub

 

[tbft]

Re : Remplir une matrice en VBA

Bonjour

une autre approche (encore..)

for i=1 to toto step 10
lite des trucs à faire...
next i

 

[Excel-lent]

Re : Remplir une matrice en VBA

Bonsoir Benjo, le fil,

Sans ton fichier je peux te dire que cela :

i = 0
For j = 3 To 120

If (j - 2) / 10 - Int((j - 2) / 10) = [COLOR="Red"][B]"0"[/B][/COLOR] Then
[COLOR="Blue"][B]i = i[/B][/COLOR]

Else
i = i + 1

End If

Matrice_Variations(i, 1) = Cells(j, 2).Value 'pour le moment je vois si ca fonctionne avec un simple copie colle de cellule


Next
Worksheets("Agreg2").Activate
For i = 1 To 120
Cells(i, 1).Value = Matrice_Variations(i, 1)
Next
End Sub

i = i -> j'en vois pas l'intérêt dans ce code!
"0" -> à mon avis, il ne faut pas mettre le zéro entre guillemet! Car la présence de guillemet signifie que tu compare le résultat d'une formule (donc le résultat obtenu est un nombre), avec du texte (car 0 est entre guillemet)

Dernier point, mais entièrement personnel et ne changeant rien au résultat donnée par la macro :
-> rajout de quelques sauts de lignes
-> rajout de plusieurs retrait de lignes

C'est tout simple, ne coûte rien, prend très peu de temps, mais apporte beaucoup à la compréhension du code

Voici comment j'aurais écris ton code :

i = 0

For j = 3 To 120
    If (j - 2) / 10 - Int((j - 2) / 10) <> 0 Then
         i = i + 1
    End If

   Matrice_Variations(i, 1) = Cells(j, 2).Value 'pour le moment je vois si ca fonctionne avec un simple copie colle de cellule

Next j

Worksheets("Agreg2").Activate

For i = 1 To 120
   Cells(i, 1).Value = Matrice_Variations(i, 1)
Next i

End Sub

Après... cela reste théorique, car n'ayant pas ton fichier, j'ai aucun moyen de me contrôler.

Bonne fin de soirée

PS. : utiliser deux fois la même variable i mais pour deux choses différentes!?!? Perso., je trouve plus clair d'en choisir une troisième bien distinct