XL 2016 Extraire chaine de caractères

KTM

XLDnaute Impliqué
Bonjour chers tous
Je voudrais dans ma chaine de caractères repérer le mot SIG puis extraire toute la chaine qui se trouve à gauche.
Un code VBA de Préférence.

exemple :
Juin 2024 SIG - Nombre total des personnes dépistées malnutris au cours du mois >>>>>>>> Juin 2024

Merci...
 

Pièces jointes

  • Extraire.xlsm
    9.9 KB · Affichages: 10

laurent950

XLDnaute Barbatruc
Bonsoir @KTM, le forum

si : la saisie en amont n'a pas était vérifié !
Un code VBA de Préférence.
Decembre 2024 SIG - Nombre total... = Correction par VBA

VB:
Sub Sig()
    Dim i As Integer
    Dim dateText As String
    Dim correctedDate As String
  
    For i = 2 To 4
        ' Récupère le texte de la date
        dateText = Split(Cells(i, 1), "SIG")(0)
      
        ' Corrige les erreurs communes dans le nom du mois
        correctedDate = CorrigerMois(dateText)
      
        ' Essaye de convertir et de formater le texte corrigé en date
        On Error Resume Next
        Cells(i, 3).Value = Format(CDate(correctedDate), "mmmm-yy")
        If Err.Number <> 0 Then
            ' Si la conversion échoue, corrige le texte original dans la cellule source
            Cells(i, 1).Value = Replace(Cells(i, 1).Value, dateText, correctedDate)
            Cells(i, 3).Value = Format(CDate(CorrigerMois(correctedDate)), "mmmm-yy")
        End If
        On Error GoTo 0
    Next i
End Sub

Function CorrigerMois(dateText As String) As String
    ' Remplace les caractères incorrects par les bons
    dateText = Replace(dateText, "Decembre", "Décembre")
    dateText = Replace(dateText, "Fevrier", "Février")
    dateText = Replace(dateText, "Aout", "Août")
  
    ' Ajoutez d'autres remplacements si nécessaire
  
    ' Retourne le texte corrigé
    CorrigerMois = dateText
End Function
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re

@laurent950
Sinon pour du vba, on pourrait faire un plus court, non ?
(mais en mode "destructif")
Code:
Sub Extraire_light()
Dim t, d_l&
d_l = Cells(Rows.Count, 1).End(xlUp).Row
t = Array(Array(1, 1), Array(2, 9))
Columns("A:A").Replace What:=" SIG - ", Replacement:="$", LookAt:=xlPart, SearchOrder:=xlByRows
Range("A2:A" & d_l).TextToColumns Destination:=Range("B2"), DataType:=1, Other:=-1, OtherChar:="$", FieldInfo:=t
End Sub
 

job75

XLDnaute Barbatruc
Classique :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
With Range("B2:B" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    Application.EnableEvents = False
    .FormulaR1C1 = "=IFERROR(LEFT(RC[-1],SEARCH(""SIG"",RC[-1])-1),"""")"
    .Value = .Value 'supprime les formules
    Application.EnableEvents = True
End With
End Sub
 

Pièces jointes

  • Extraire.xlsm
    16 KB · Affichages: 2

laurent950

XLDnaute Barbatruc
Bonsoir @job75, @Staple1600,

Dans le Post #1, ce n'est pas expliqué explicitement, mais l'idée est de récupérer le texte avant "SIG" et, une fois récupéré, de le convertir en date dans la cellule.

Par exemple : la cellule B3 ne peut pas être transformée en date car "Decembre" est mal orthographié.

le Poste #4 (Fait la Correction via VBA = Format Date)/ C'est la demande a mon avis
le Poste #11 (Ne Fait pas la Correction via VBA = Format Texte) / C'est pas la demande a mon avis
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @KTM :) et bonjour à tous les autres ;) ,

Une fonction personnalisée qui renvoie une date au sens Excel.
La fonction est utilisable sur une feuille de calcul ou sur dans du code VBA.

La fonction s'appelle est : DebutEnDAte( xtxt ) - xtxt est le texte dont on extrait la date.

nota : si la conversion en date est impossible alors on retourne la chaine vide.
nota : on peut mettre ou non des lettres accentuées dans les mois

Dans le classeur, on a l'utilisation sur la feuille (en colonne B) et au sein d'un code VBA (cliquer sur le bouton bleu).

Le code de la fonction dans Module1 :
VB:
Function DebutEnDAte(ByVal xtxt)
Const Mois = "ja f ar av ai in il ao pt ct ov ce"
Dim t, i
   DebutEnDAte = ""
   t = Split(Application.Trim(xtxt))
   i = Application.Match(True, Application.IsNumber(Application.Search(Split(Mois), t(0))), 0)
   If IsError(i) Then Exit Function
   On Error Resume Next
   DebutEnDAte = CDate(i & "/" & t(1))
End Function
 

Pièces jointes

  • KTM- Texte en date- v1.xlsm
    20.6 KB · Affichages: 1
Dernière édition:

job75

XLDnaute Barbatruc
Dans le Post #1, ce n'est pas expliqué explicitement, mais l'idée est de récupérer le texte avant "SIG" et, une fois récupéré, de le convertir en date dans la cellule.
A mon avis c'est mieux de récupérer un texte car cela conserve la casse.

Mais bon pour avoir une date utilisez :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
With Range("B2:B" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    Application.EnableEvents = False
    .FormulaR1C1 = "=IFERROR(--LEFT(RC[-1],SEARCH(""SIG"",RC[-1])-1),"""")"
    .Value = .Value 'supprime les formules
    .NumberFormat = "mmmm * yyyy" 'format Date
    .Columns.AutoFit 'ajustement largeur
    Application.EnableEvents = True
End With
End Sub
 

Pièces jointes

  • Extraire.xlsm
    15.9 KB · Affichages: 5

Discussions similaires

Statistiques des forums

Discussions
314 644
Messages
2 111 528
Membres
111 189
dernier inscrit
Laurent.