XL 2010 Problème Algorithme avec imbrication de boucles!

[Johan]

Bonjour à tous,

Si vous êtes un peu matheux, cet algorithme est pour vous !

Dans le fichier joint, j'ai des données de pression que je souhaite analyser, et ainsi calculer chaque chute de pression (un graphique montre les 4 différentes chutes décrivant un pic)

L'algorithme est le suivant :

1/ Lorsque la pression passe pour la première fois sous 0,6 bar, on l'enregistre et on attend une chute de 0,3 bars (descente)
=> on lance le calcul jusqu'à obtenir la valeur minimum de la descente et on compte "+1 vide"
2/ Lorsque valeur courante supérieure à 0,3 bar du minimum = on est remonté
=> Reboucler jusqu'à compter tous les vides (4)

Malheureusement je ne m'en sors pas en enchaînant les conditions, je pense que des boucles while ou do until seraient un peu plus efficaces mais je ne maîtrise pas... Je vous conseille d'abuser des points d'arrêt pour savoir comment se comportent les boucles !

Mon code actuel :

Sub CalculChutePresson()
Dim nbVides As Integer
nbVides = 0 'Nombre de vides à compter, pris en compte une fois une chute de pression de 0,3 bar constatée

Dim videMini As Double
videMini = 0.6 'Valeur du vide mini. Réinitialisé à 0,6 à chauqe fois



ligneTotal = ActiveSheet.UsedRange.Rows.Count


For x = 2 To ligneTotal

valeurPression = Cells(x, 4).Value
valeurPressionApres = Cells(x + 1, 4).Value
valeurPressionAvant = Cells(x - 1, 4).Value
                                                                       
  If valeurPression <= 0.6 Then
    If valeur06 = "" Then
        valeur06 = valeurPression
    End If
  End If
 
If valeur06 <> "" Then
    If valeur06 - valeurPression > 0.3 Then
        If valeurPression <= videMini Then
            videMini = valeurPression
            If videMini < valeurPressionApres Then
                nbVides = nbVides + 1
                videMini = 0.6
            End If
        End If
    End If
End If

Next x

End Sub

Merci pour votre aide

 

[Dranreb]

Bonjour.
Combien de chutes de pression devrait-on trouver avec ces données ?
Édition: Ah oui, 4 je suppose comme l'indique le graphique. Bon j'en trouve 92, c'est pas bon…

 

[vgendron]

Hello
un essai avec ce code..

Sub Calc()
Dim tablo() As Variant
With ActiveSheet
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tablo = .Range("A2:E" & fin).Value
End With

NbChute = 0
i = LBound(tablo, 1)
While i <= UBound(tablo, 1)
    If tablo(i, 4) < 0.6 Then
        DebutChute = True
        NbChute = NbChute + 1
    Else
        i = i + 1
    End If
    If DebutChute Then
        j = i
        While tablo(j, 4) > tablo(j + 1, 4)
            j = j + 1
            If j >= UBound(tablo, 1) Then GoTo fin
        Wend
        DebutChute = False
        Debutremontée = True
        tablo(i, 5) = tablo(i, 4) - tablo(j, 4)
        While tablo(j, 4) < tablo(j + 1, 4)
            j = j + 1
            If j >= UBound(tablo, 1) Then GoTo fin
        Wend
        Debutremontée = False
        tablo(j, 5) = tablo(j - 1, 4) - tablo(i, 4)
        i = j
    End If
Wend
fin:

With Sheets("Feuil2")
    .Range("A1") = "Il y a: " & NbChute & " Chutes de pression"
    .Range("A2").Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
End With
End Sub

 

[Dranreb]

Comme ça j'en trouve 4 :

Sub test()
MsgBox NbChutesPression(ActiveSheet.[A1].CurrentRegion) & " chutes de pression trouvées", vbInformation, ActiveSheet.Name
End Sub
Function NbChutesPression(ByVal RDon As Range) As Long
Dim TDon(), Press As Double, AuDessus As Boolean, L As Long
TDon = RDon.Value
AuDessus = True
For L = 2 To UBound(TDon, 1)
   Press = TDon(L, 4)
   If Press < 0.6 And AuDessus Then NbChutesPression = NbChutesPression + 1
   AuDessus = Press > 0.6
   Next L
End Function

Édition: Maintenant s'il y a des cas de figure où il faut en compter davantage pendant que la pression reste sous la barre des 0,6 mettez des données représentatives de ce cas de figure.