Extraire chaine de caracteres : Résolu

[guigus]

Bonjour à tous,

je souhaite extraire une chaine de caractère dans une cellule. Le problème pour moi c'est que je peux avoir 2 lignes dans une même cellule où je dois extraire des données.
L'exemple ci joint illustre parfaitement mon problème.

Je pense qu'il est nécessaire de passer par un tableau. Et là c'est un vrai cauchemar pour moi. J'ai beaucoup de mal à comprendre comment manipuler les tableaux en VB.

Pouvez vous m'aider à comprendre pourquoi mon code tourne en boucle ? et comment faire pour résoudre ce problème.

Merci par avance

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")
Columns("B").ClearContents
Tableau_Chaine_Histo = Split(fData.Cells(ligne, "A").Value, vbLf)

For i = 0 To UBound(Tableau_Chaine_Histo)
NbHeureHisto = CInt(Left(Tableau_Chaine_Histo(i), InStr(1, Tableau_Chaine_Histo(i), "heures") - 1))
fData.Cells(ligne, "B").Value = fData.Cells(ligne, "B").Value + NbHeureHisto
Exit For
Next i

End Sub

 

[JPierreM]

Re : Extraire chaine de caracteres

Bonjour,

Columns("B").ClearContents déclanche la macro Private Sub Worksheet_Change(ByVal target As Range)
donc le reste de la macro ne peut s'éxécuter

fData.Cells(ligne, "B").Value = fData.Cells(ligne, "B").Value + NbHeureHisto provoquera le même effet

JP

 

[tototiti2008]

Re : Extraire chaine de caracteres

Bonjour guigus,

un essai

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

 

[PascalXLD]

Re : Extraire chaine de caracteres

Bonjour

essaies ainsi :

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

 

[tototiti2008]

Re : Extraire chaine de caracteres

Bonjour Pascal,
Re,

ou alors, plutôt qu'une procédure évènementielle (Change) je préconiserais plutôt une fonction personnalisée

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

Puis mettre la formule en B1

=nbheurehisto(A1)

 

[guigus]

Re : Extraire chaine de caracteres

Merci tototiti2008, PascalXLD et JPierreM pour vos réponses.

les 2 premiers codes fonctionnent parfaitement et me vont très bien (je n'ai pas encore testé le 3ème)

C'est nickel !