Extraire chaine de caracteres : Résolu

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim ligne, NbHeureHisto As Long
  Dim i As Integer
  Dim Tableau_Chaine_Histo() As String
    If Target.Count = 1 Then
        If Target.Column = 1 And Target.Value <> "" Then
            ligne = Target.Row
            Tableau_Chaine_Histo = Split(Target.Value, vbLf)
            NbHeureHisto = 0
            On Error Resume Next
            For i = 0 To UBound(Tableau_Chaine_Histo)
               NbHeureHisto = NbHeureHisto + CLng(Left(Tableau_Chaine_Histo(i), InStr(1, Tableau_Chaine_Histo(i), "heures") - 1))
            Next i
            On Error GoTo 0
            Target.Offset(0, 1).Value = NbHeureHisto
        End If
    End If
End Sub

Private Sub Worksheet_Change(ByVal target As Range)
  Dim ligne, NbHeureHisto As Long
  Dim i As Integer
  Dim Tableau_Chaine_Histo() As String
  Dim fData As Worksheet
 
    ligne = target.Row
 
    Set fData = ActiveWorkbook.Sheets("Data")
    Application.EnableEvents = False
    Columns("B").ClearContents
    Application.EnableEvents = True
    
    Tableau_Chaine_Histo = Split(fData.Cells(ligne, "A").Value, vbLf)
    NbHeureHisto = 0
        For i = 0 To UBound(Tableau_Chaine_Histo)
            tableau_suite = Split(Tableau_Chaine_Histo(i), " ")
           NbHeureHisto = NbHeureHisto + tableau_suite(0)
        Next i
    Range("B" & ligne) = NbHeureHisto
    
End Sub

Function NbHeureHisto(Cellule As Range) As Long
Dim Tablo
    Tablo = Split(Cellule.Value, vbLf)
    NbHeureHisto = 0
    If Not IsArray(Tablo) Then Tablo = Array(Cellule.Value)
    For i = LBound(Tablo) To UBound(Tablo)
        If InStr(1, Tablo(i), "heure") > 0 Then
            If IsNumeric(Left(Tablo(i), InStr(1, Tablo(i), "heure") - 1)) Then
                NbHeureHisto = NbHeureHisto + CLng(Left(Tablo(i), InStr(1, Tablo(i), "heure") - 1))
            End If
        End If
    Next i
End Function

=nbheurehisto(A1)