Ciao Paolo,
Visto che i tuoi 2 thread sono legati allo
stesso problema, tentero' a rispondere
ad entrambi qui.
Prima di suggerire una soluzione, vorrei
ricapitulare la tua esigenza e i problemi
che incontri.
Comnciando con una matrice di dati su un
foglio, ad esempio l'intervallo B2:H6k, hai
l'esigenza copiare i dati in un array, ordinare
l'array e poi copiare l'array ordinato in un
secondo intervallo sul foglio, ad esempio
B12:H16.
Il secondo aspetto del problema e' di utilizzare
una UDF matriciale che legge i dati riordinati
e restituisci una matrice come risultato.
Per caricare l'array, riordinare i dati e copiare
i dati riordinati sul foglio, prova qualcosa del
genere:
'========>>
Option Explicit
Public Sub TesterSort()
Dim Rng As Range
Dim vArr As Variant
Dim bAscending As Boolean
Set Rng = Range("B2:H6")
vArr = Rng.Value
bAscending = False
QuickSort vArr, 4, LBound(vArr, 1), UBound(vArr, 1), bAscending
With Range("B12").Resize(UBound(vArr, 1), UBound(vArr, 2))
.Value = vArr
.Name = "RngOrdinato"
End With
End Sub
'-------------->>
Public Sub QuickSort(SortArray, col, L, R, bAscending)
'\\ Tom Ogilvy
'Originally Posted by Jim Rech 10/20/98 Excel.Programming
'Modified to sort on first column of a two dimensional array
'Modified to sort on single column
'Modified to do Ascending or Descending
Dim i, j, X, Y, mm
i = L
j = R
X = SortArray((L + R) / 2, col)
If bAscending Then
While (i <= j)
While (SortArray(i, col) < X And i < R)
i = i + 1
Wend
While (X < SortArray(j, col) And j > L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
Else
While (i <= j)
While (SortArray(i, col) > X And i < R)
i = i + 1
Wend
While (X > SortArray(j, col) And j > L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
End If
If (L < j) Then _
Call QuickSort(SortArray, col, L, j, bAscending)
If (i < R) Then _
Call QuickSort(SortArray, col, i, R, bAscending)
End Sub
'<<========
La UD|F PiPayOff diventa:
'===========>>
Option Explicit
Option Base 0
Public Function PiPayOff(NS As Long) As Double()
Dim numOfOpts As Long, c As Long, R As Long, n As Long
Dim colT As Long, colS As Long, colE As Long, colQ As Long
Dim PayOff_n As Double, maxE As Double
Dim Vals_M() As Double
Dim PiMatrix() As Variant
Dim delt_s As Double
ReDim Vals_M(NS)
colT = 1 'Type column - PUT or CALL
colS = 2 'Stock column
colE = 3 'Strike column
colQ = 7 'Quantity column
PiMatrix = Range("RngOrdinato").Value
'getMatrix(Range("rngOrdinato")) 'Range("B2:H6"))
numOfOpts = UBound(PiMatrix)
maxE = 0
For n = 1 To numOfOpts '\\ finds the max Strike
'\\ in the Portfolio
If PiMatrix(n, colE) > maxE Then
maxE = PiMatrix(n, colE)
End If
Next n
delt_s = 2 * maxE / NS '\\ calculate delta_S based
'\\ on the max strike
For n = NS To 1 Step -1 '\\ row=1: initialize Binary
'\\ Final Conds (PayOff)
Vals_M(n) = 0
PayOff_n = PiMatrix(1, colT) * _
((n * delt_s) - PiMatrix(1, colE))
If PayOff_n > 0 Then
Vals_M(n) = PiMatrix(1, colQ)
End If
Next n
For R = 2 To numOfOpts '\\ row=r: Adding all Vanilla
'\\ Final Conds (PayOff)
For n = NS To 1 Step -1
PayOff_n = PiMatrix(R, colT) * _
((n * delt_s) - PiMatrix(R, colE))
If PayOff_n > 0 Then
Vals_M(n) = Vals_M(n) + _
PiMatrix(R, colQ) * PayOff_n
End If
Next n
Next R
'For n = 1 To NS
' MsgBox Vals_M(n)
'Next n
PiPayOff = Vals_M()
End Function
'<<===========
La funzione legge i dati ordinati dall'intervallo
nominato RngOrdinato creato dalla routine
TesterSort.
Se ti fosse utilie. potrei inviarti il mio file di
prova, in risposta ad una tua email:
***@NOSPAMbtconnectDOTcom
(Cancella "NOSPAM" e sostituisci "DOT" con un punto)
---
Regards,
Norman