limba864

Macro second a parte.

Sub Aggiorna_Tabella()

Riga_tab = Riga_tab + 1
Worksheets("VWAP").Cells(Riga_tab, 2).Value = VWAP
Worksheets("VWAP").Cells(Riga_tab, 4).Value = PrezzoFUT
Worksheets("VWAP").Cells(Riga_tab, 6).Value = deltaFUT
Worksheets("VWAP").Cells(Riga_tab, 8).Value = PVP
Worksheets("VWAP").Cells(Riga_tab, 10).Value = VWAP + Worksheets("VWAP").Cells(1, 1).Value 'errore all'inizio
Worksheets("VWAP").Cells(Riga_tab, 12).Value = VWAP + Worksheets("VWAP").Cells(1, 1).Value * 2 'errore all'inizio
End Sub

Sub Aggiorna_PVP()
Dim Max As Long
Dim Valore As Long

Cella_pvp = Worksheets("VWAP").Range("M1").Value
Cella_vwap = Worksheets("VWAP").Range("N1").Value

For I = 1 To 400
If Worksheets("PVP").Cells(I, 1).Value = PrezzoFUT Then
Worksheets("PVP").Cells(I, 2).Value = Worksheets("PVP").Cells(I, 2).Value + 1
I = 399
End If
Next I

'Determina PVP
Max = 0

Worksheets("PVP").Cells(Cella_pvp, 3).Value = ""
Worksheets("PVP").Cells(Cella_vwap, 4).Value = ""
For I = 1 To 400
If Worksheets("PVP").Cells(I, 2).Value >= Max Then
PVP = Worksheets("PVP").Cells(I, 1).Value
Cella_pvp = I
Worksheets("VWAP").Range("M1").Value = Cella_pvp
Max = Worksheets("PVP").Cells(I, 2).Value
End If

Valore = VWAP / 10
Valore = Round(Valore) * 10
Worksheets("PVP").Cells(230, 4).Value = Valore
If Worksheets("PVP").Cells(I, 1).Value = Valore Then
Cella_vwap = I
Worksheets("VWAP").Range("N1").Value = Cella_vwap
Worksheets("PVP").Cells(Cella_vwap, 4).Value = Max

End If
Next I
Worksheets("PVP").Cells(Cella_pvp, 3).Value = Max
Worksheets("Fut").Range("O12").Value = PVP

End Sub


Sub Inizializza()

Dim Chiusura As Long

Worksheets("PVP").Range("A1400").Value = ""
Worksheets("VWAP").Range("A2:L8000").Value = ""
Worksheets("Fut").Range("A40:E50").Value = ""
Worksheets("Fut").Range("F40:H40").Value = ""
Worksheets("Fut").Range("O11:O12").Value = ""

Chiusura = Round(Worksheets("Fut").Range("O9").Value / 5, 0)
Chiusura = Chiusura * 5
For I = 0 To 399
Worksheets("PVP").Cells(I + 1, 1).Value = Chiusura + ((I - 200) * 5)
Next I

Cella_pvp = 1
Cella_vwap = 1
Riga_tab = 1

Worksheets("VWAP").Range("M1").Value = Cella_pvp
Worksheets("VWAP").Range("N1").Value = Cella_vwap
Worksheets("VWAP").Range("B2:B3").Value = 1

End Sub


Sub Aggiorna_Tabella_ISP()
' vuota
End Sub

Ecco la macro ( prima parte perchè mi ha dato l'avviso di messaggio troppo lungo ).
Prende i dati dal foglio Excel ( che viene aggiornato automaticamente tramite DDE ) e li elabora.
I dati letti erano relativi a ISP e Future Mib.
Trovi anche qualche commento all'interno delle routines.

Usala per te ma non distribuirla.
Ciao e buon lavoro!



Option Explicit

'Dichiarazione variabili
Dim oldValueFUT, oldValueISP, Trovato As Variant
Dim Riga, Riga_tab As Integer
Dim Riga_stamp As Integer
Dim I As Integer
Dim car As String
Dim deltaFUT As Long, deltaISP, PVP As Long
Dim VWAP As Long
Dim ProdottoN_1 As Long
Dim PrezzoFUT, PrezzoISP, OLD_PrezzoISP, BidISP, AskISP As Variant
Dim Tabella(10, 3) As Variant
Dim Cella_pvp, Cella_vwap As Long

' Riga_tab = 1




Sub Start()

Inizializza

Worksheets("Fut").OnCalculate = "AvvisoCellaCambiata"
oldValueFUT = Worksheets("Fut").Range("K10").Value
oldValueISP = Worksheets("Fut").Range("K23").Value

End Sub


Sub AvvisoCellaCambiata()
'Quando la routine viene chiamata a seguito di un calcolo
'controllo se il vecchio valore è diverso da quello attuale.
'Se lo è la cella è cambiata, per cui memorizzo il nuovo valore
'in oldValue

If oldValueFUT <> Worksheets("Fut").Range("K10").Value Then
deltaFUT = Worksheets("Fut").Range("K10").Value - oldValueFUT
Worksheets("Fut").Range("K11").Value = deltaFUT
oldValueFUT = Worksheets("Fut").Range("K10").Value
PrezzoFUT = Worksheets("Fut").Range("C10").Value
VWAP = (ProdottoN_1 + (PrezzoFUT * deltaFUT))
Worksheets("Fut").Range("O12").Value = VWAP
VWAP = VWAP / Worksheets("Fut").Range("K9").Value
Worksheets("Fut").Range("O11").Value = VWAP
Aggiorna_Tabella

ProdottoN_1 = ProdottoN_1 + (PrezzoFUT * deltaFUT)
' MsgBox "Cambiato!"
Aggiorna_PVP

End If

If oldValueISP <> Worksheets("Fut").Range("K23").Value Then
deltaISP = Worksheets("Fut").Range("K23").Value - oldValueISP
Worksheets("Fut").Range("K24").Value = deltaISP
oldValueISP = Worksheets("Fut").Range("K23").Value

' Cont = Cont + 1
Riga = Riga + 1
If Riga > 10 Then Riga = 1

OLD_PrezzoISP = PrezzoISP
PrezzoISP = Worksheets("Fut").Range("C23").Value
BidISP = Worksheets("Fut").Range("G23").Value
AskISP = Worksheets("Fut").Range("H23").Value
' Worksheets("Fut").Range("G24").Value = BidISP
' Worksheets("Fut").Range("H24").Value = AskISP

If PrezzoISP = BidISP Then
Worksheets("Fut").Range("L24").Value = "V"
car = "V"
Trovato = 1
' Stampa_DatoV
End If
If PrezzoISP = AskISP Then
Worksheets("Fut").Range("L24").Value = "A"
Trovato = 1
car = "A"
' Stampa_DatoA
End If

If Trovato = 0 Then
If PrezzoISP > OLD_PrezzoISP Then
Worksheets("Fut").Range("L24").Value = "A"
Trovato = 1
car = "A"
End If
If PrezzoISP < OLD_PrezzoISP Then
Worksheets("Fut").Range("L24").Value = "V"
Trovato = 1
car = "V"
End If
End If

If Trovato = 0 Then
Worksheets("Fut").Range("L24").Value = " "
' Stampa_Dato
car = ""
End If

Trovato = 0
If deltaISP >= 1000 Then
Stampa_Righe
End If

' Aggiorna_Tabella_ISP

End If

End Sub


Sub Stampa_Righe()

Dim Cumulativo_Acq, Cumulativo_Ven, Cumulativo_Neu As Long

Tabella(Riga, 1) = PrezzoISP
Tabella(Riga, 2) = deltaISP
Tabella(Riga, 3) = car
For I = 1 To 10
Riga_stamp = ((Riga + I) \ 11) + ((Riga + I) Mod 11)
Worksheets("Fut").Cells(39 + I, 1).Value = Tabella(Riga_stamp, 1)
Worksheets("Fut").Cells(39 + I, 3).Value = Tabella(Riga_stamp, 2)
Worksheets("Fut").Cells(39 + I, 5).Value = Tabella(Riga_stamp, 3)
Next I


Cumulativo_Acq = 0
Cumulativo_Ven = 0
Cumulativo_Neu = 0
For I = 1 To 10
If Tabella(I, 3) = "A" Then
Cumulativo_Acq = Cumulativo_Acq + Tabella(I, 2)
End If
If Tabella(I, 3) = "V" Then
Cumulativo_Ven = Cumulativo_Ven + Tabella(I, 2)
End If
If Tabella(I, 3) = "" Then
Cumulativo_Neu = Cumulativo_Neu + Tabella(I, 2)
End If
Next I
Worksheets("Fut").Cells(40, 6).Value = Cumulativo_Acq
Worksheets("Fut").Cells(40, 7).Value = Cumulativo_Ven
Worksheets("Fut").Cells(40, 8).Value = Cumulativo_Neu
End Sub

No sull'eurostoxx non c'e' nulla che io sappia.Il ts a oggi e' in leggerissimo guadagno per il mese di luglio.
Ciao