Interpolation température

Résolu
Bonjour,

Je souhaiterai écrire une macro VBA qui effectue une interpolation de température avec un [I]pas fixe d'1 heure[/I], à partir de données récupérées avec des [I]pas[/I] variables.

date               heure       T°C      diff heure
13/07/2013	00:00:00	33,2	    3
12/07/2013	21:00:00	35,2	    3
12/07/2013	18:00:00	38,6	    3
12/07/2013	15:00:00	40	    3
12/07/2013	12:00:00	38,4	    3
12/07/2013	09:00:00	33,2	    3
12/07/2013	06:00:00	30,8	    1
12/07/2013	05:00:00	30,8	    2
12/07/2013	03:00:00	30,8	    3
12/07/2013	00:00:00	32,6	    1
11/07/2013	23:00:00	32,6	    2
11/07/2013	21:00:00	34	    3


par exemple, je souhaite interpoler [COLOR="#FF0000"][33,2°C][/COLOR] et [COLOR="#FF0000"][35,2°C][/COLOR] cela donne une température moyennée entre les deux avec un pas d'une heure

date                  heure        T°C      diff heure
13/07/2013	00:00:00	33,2	    1
12/07/2013	23:00:00	33,8	    1
12/07/2013	22:00:00	34,4	    1
12/07/2013	21:00:00	35,2	    1

5 réponses

  1. Contributeur
    bonsoir Et quelle est la question, qu'attends-tu du forum?
    Quelle programme utilises-tu?
    1. Bonjour qwerty_213,

      Je te propose ce fichier Excel 2007.

      < Ctrl >< e > => travail effectué ; vérifie si tous les
      résultats sont bien conformes à ceux que tu attends.

      < Alt >< F11 > pour aller sur Visual Basic, puis revenir
      sur ta feuille Excel ; la macro est dans Module1.

      Dis-moi ce que tu en penses, et si ça te convient.
      Tu peux me demander une adaptation si besoin.

      Si ton problème est réglé, merci d'aller en haut de page
      pour cliquer sur « Marquer comme résolu ».

      Cordialement.  :)
       
      1. merci albkan, cela marche très bien,

        je vais l’intégrer dans mon programme global pour calculer la température sur plusiures années
    2. ca marche aussi, merci gbinforme
      1. Contributeur
        Bonsoir qwerty_213 et merci du retour.
    3. Bonjour le forum,

      Voici le code VBA de mon fichier Excel 2007 de mon message #3 :

      
      Option Explicit
      
      
      Sub Essai()
        Application.ScreenUpdating = False
        Dim dateH As Double, dateX As Double, dlig As Long
        Dim ligA As Long, ligB As Long, k As Byte, i As Byte
        Dim T1 As Single, T2 As Single, DT As Single, T3 As Single
        dlig = Range("F" & Rows.Count).End(xlUp).Row
        If dlig > 1 Then Range([F2], Cells(dlig, 9)).ClearContents
        ligA = 2: ligB = 2
        Do While Cells(ligA, 1) <> ""
          k = Cells(ligA, 4): If IsEmpty(Cells(ligA + 1, 1)) Then k = 0
          Range(Cells(ligA, 1), Cells(ligA, 3)).Copy: Cells(ligB, 6).PasteSpecial -4163
          If k > 1 Then
            dateH = Cells(ligA, 1) + Cells(ligA, 2)
            T1 = Cells(ligA, 3): T2 = Cells(ligA + 1, 3): DT = (T2 - T1) / k: T3 = T1
            For i = 1 To k
              ligB = ligB + 1: dateH = dateH - (1 / 24): dateX = Int(dateH)
              Cells(ligB, 6) = dateX: Cells(ligB, 7) = dateH - dateX
              T3 = T3 + DT: Cells(ligB, 8) = Format(T3, "0.0")
            Next i
          Else
            ligB = ligB + 1
          End If
          ligA = ligA + 1
        Loop
        Range([I2], Cells(ligB - 1, 9)) = 1: [A1].Select
        Application.CutCopyMode = False
      End Sub
      
      

      Vous pouvez lire aussi la réponse du demandeur.

      Cordialement.  :)