Avoir un commentaire automatique...

Option Explicit

Sub MàjCommentairePluie()
Dim c As Range
  Set c = Worksheets("Janvier_2018").Range("BT19")
  Call CommentairePluie(c, True)
End Sub

Private Sub CommentairePluie(dst As Range, AM As Boolean)
' Met en place les heures de pluie en commentaire de la cellule dst
' Arguments : dst                 [in]  cellule destination
'             AM                  [in]  Vrai si matin et Faux si après-midi
' 07/01/18
Dim rng As Range
Dim cel As Range
Dim deb As String
Dim fin As String
Dim cmt As String

  With Worksheets("Relevés")
    Set rng = .Range("H9", .Cells(.Rows.Count, "H").End(xlUp))
  End With
  For Each cel In rng.Cells
    If cel.Value > 0 Then
      If AM And cel.Offset(0, 3) < 0.5 Or Not AM And cel.Offset(0, 3) >= 0.5 Then
        If deb = "" Then
          deb = Format(cel.Offset(0, 3).Value, "h""h""mm")
        Else
          fin = Format(cel.Offset(0, 3).Value, "h""h""mm")
        End If
      End If
    Else
      If deb <> "" Then
        If fin = "" Then fin = deb
        cmt = cmt & vbCrLf & deb & " à " & fin
        deb = ""
        fin = ""
      End If
    End If
  Next cel
  If cmt > "" Then
    cmt = "Pluie de :" & cmt
    With dst
      .ClearComments
      .AddComment
      .Comment.Text Text:=cmt
      .Comment.Shape.TextFrame.AutoSize = True
    End With
  End If
End Sub