[MarcoGG]

Originariamente inviato da Kimiko

Mi piacerebbe sapere anche la tua soluzione, visto che cmq questa non mi soddisfa appieno.
Ciao e buona serata!

Al momento sono abbastanza fuso, perciò niente preamboli, ti metto giù una breve introduzione e relativo codice completo della soluzione :

1. Ho un file Excel, che può contenere anche solo un foglio, Foglio1.

2. Foglio1 è organizzato come segue :
- Cella A1 : contiene i valori DDE.
- Colonne da B a F : Tabella valori ( 1 nuova riga ogni intervallo -> 180 sec. ).
- 2 CommandButton : Start e Stop registrazione valori.

Vedi figura :



3. Codice che esegue il CommandButton START :

Private Sub CommandButton1_Click()
  
    Sheets("Foglio1").Range("C2:F4").ClearContents
    Sheets("Foglio1").Range("C2").FormulaR1C1 = Sheets("Foglio1").Range("A1").Value
    
    intervallo = 180 'SECONDI
    contaSecondi = 0
    contaIntervalli = 2
    CommandButton1.Enabled = False
    
    ReDim arrayValori(0)
    
    StartTimer

End Sub

4. Codice che esegue il CommandButton STOP :

Private Sub CommandButton2_Click()

    EndTimer
    CommandButton1.Enabled = True
    
End Sub

5. Codice da inserire in un MODULO :

Public intervallo As Integer
Public contaIntervalli As Integer
Public contaSecondi As Integer
Public arrayValori() As Double
Public TimerID As Long
Public TimerSeconds As Single

Public Declare Function SetTimer Lib "user32" ( _
        ByVal HWnd As Long, _
        ByVal nIDEvent As Long, _
        ByVal uElapse As Long, _
        ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" ( _
        ByVal HWnd As Long, _
        ByVal nIDEvent As Long) As Long

Public Sub StartTimer()
    TimerSeconds = 1 'Intervallo di Intervento Timer in Secondi.
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

Public Sub EndTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
End Sub

Public Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
    ByVal nIDEvent As Long, ByVal dwTimer As Long)

    AGG_ARRAY_VALORI (Sheets("Foglio1").Range("A1").Value)
    If contaSecondi = intervallo Then
        Sheets("Foglio1").Range("F" & contaIntervalli).FormulaR1C1 = Sheets("Foglio1").Range("A1").Value
        Sheets("Foglio1").Range("D" & contaIntervalli).FormulaR1C1 = arrayValori(1)
        Sheets("Foglio1").Range("E" & contaIntervalli).FormulaR1C1 = arrayValori(UBound(arrayValori))
        ReDim arrayValori(0)
        contaIntervalli = contaIntervalli + 1
        contaSecondi = 0
    End If
    If (contaSecondi - 1) Mod intervallo = 0 And contaIntervalli > 2 Then
        Sheets("Foglio1").Range("C" & contaIntervalli).FormulaR1C1 = Sheets("Foglio1").Range("A1").Value
    End If
    contaSecondi = contaSecondi + 1
    
End Sub

Public Sub AGG_ARRAY_VALORI(valore As Double)

    Dim valRedim As Long
    valRedim = UBound(arrayValori) + 1
    ReDim Preserve arrayValori(valRedim)
    arrayValori(valRedim) = valore
    Dim Temp As Double
    Dim i As Long
    Dim j As Long
    For j = 2 To UBound(arrayValori)
        Temp = arrayValori(j)
        For i = j - 1 To 1 Step -1
            If (arrayValori(i) <= Temp) Then GoTo 10
            arrayValori(i + 1) = arrayValori(i)
        Next i
        i = 0
10          arrayValori(i + 1) = Temp
    Next j

End Sub

6. Provare...