Resolu

Guido · 24 Mars 2016

Bonjour le forum

J'aimerais garder seulement une partie d'une phrase

Course: R.1-C.7 Hippodrome: SAINT-CLOUD Allocation: 16000 € Discipline: PLAT Spécialité: RECLAMER

Course: R.1-C.7

Course: R.3-C.2 Hippodrome: CAEN Allocation: 19000 € Discipline: ATTELE

Course: R.3-C.2

Ses entetes se trouvent dans une feuille excel en colonne B et toutes les 20 lignes environs mais max sur 1000 lignes

Merci pour votre aide

Guido

DoubleZero · 24 Mars 2016

Re : Garder seulement une partie d'une phrase......

Bonjour, Guido, le Forum,

Comme ceci ?

Code:

Option Explicit
Sub Remplacer()
    Columns(2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=" Hippodrome*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

A bientôt 🙂

Guido · 26 Mars 2016

Re : Garder seulement une partie d'une phrase......

Bonsoir DoubleZero et le forum

Merci pour la formule de la macro

J'ai rajouter d'autres action pour supprimer..voici la macro...

Sub Remplacer()
Columns(2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=" Hippodrome*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns(2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=" Terrain*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns(2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=" Public*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns(2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=" Sp1*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns(2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=" Jp1*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns(17).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=" Gc2*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns(17).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=" Gct2*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns(26).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=" Gc2*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns(26).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=" Gct2*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

Question y a t'il plus simple comme formule..

Merci

Guido

eriiic · 26 Mars 2016

Re : Garder seulement une partie d'une phrase......

Bonjour,

tout dépend ce que tu peux avoir sur les 19 autres lignes, ce que tu ne dis pas.
eric

Guido · 26 Mars 2016

Re : Garder seulement une partie d'une phrase......

eriiiic à dit:
Bonjour,

tout dépend ce que tu peux avoir sur les 19 autres lignes, ce que tu ne dis pas.
eric

Re

Voici le fichier avec feuille brut ,feuille lessivéé et feuilles de transfert ( pour la suite du fichier)

Merci a plus

Guido

eriiic · 27 Mars 2016

Re : Garder seulement une partie d'une phrase......

Sur la feuille Prono Brut :

Code:

Sub nettoyer()
    Dim datas, lig As Long, p As Long
    datas = [B1].Resize(Cells(Rows.Count, "B").End(xlUp).Row).Value
    For lig = 1 To UBound(datas)
        If Left(datas(lig, 1), 8) = "Course: " Then
            p = InStr(9, datas(lig, 1), " ") - 1
            If p > 0 Then datas(lig, 1) = Left(datas(lig, 1), p)
        End If
    Next lig
    [B1].Resize(UBound(datas)) = datas
End Sub

eric

Guido · 28 Mars 2016

Re : Garder seulement une partie d'une phrase......

Bonjour eriiiic et le Forum

ta formule ne fonctionne... pas sur mon fichier...

Donc je vais garder...la mienne

Merci

a bientôt

Guido

eriiic · 28 Mars 2016

Re : Garder seulement une partie d'une phrase......

Bonjour,

pourtant...

JCGL · 28 Mars 2016

Re : Garder seulement une partie d'une phrase......

Bonjour à tous,

Peux-tu essayer ceci :

VB:

Sub Nettoyage()
    Dim Lig As Long
    For Lig = 1 To 1000
        If Left(Cells(Lig, 2), 6) = "Course" Then Cells(Lig, 2) = Left(Cells(Lig, 2), 15)
        If Left(Cells(Lig, 2), 8) = "Distance" Then Cells(Lig, 2) = Left(Cells(Lig, 2), 16)
        If Left(Cells(Lig, 2), 7) = "Horaire" Then Cells(Lig, 2) = Left(Cells(Lig, 2), 14)
        If Left(Cells(Lig, 2), 3) = "Sg1" Then Cells(Lig, 2) = Left(Cells(Lig, 2), 10)
        If Left(Cells(Lig, 2), 3) = "Jg1" Then Cells(Lig, 2) = Left(Cells(Lig, 2), 10)
    Next Lig
End Sub

A+ à tous

Guido · 28 Mars 2016

Re : Garder seulement une partie d'une phrase......

Re RCGL

J'aimerais garder seulement une partie d'une phrase,voici quelque exp...

Course: R.1-C.7

Course: R.2-C.7

Course: R.3-C.2

Course: R.4-C.2

Avec ton debut de macro il me reste que C1 OU C2 ect...

Merci

Guido

JCGL · 28 Mars 2016

Re : Garder seulement une partie d'une phrase......

Bonjour à tous,

Et pourtant...

A+ à tous

job75 · 29 Mars 2016

Re : Garder seulement une partie d'une phrase......

Bonjour Guido, DoubleZero, eriiiic, Jean-Claude,

Pourquoi supprimer du texte qui peut servir ? Il suffit de le masquer :

Code:

Sub Debut_Tout()
If IsError(Application.Caller) Then Exit Sub
Dim tout As Boolean, c As Range
With ActiveSheet.DrawingObjects(Application.Caller)
  tout = .Text = "Tout"
  .Text = IIf(tout, "Début", "Tout")
End With
Application.ScreenUpdating = False
For Each c In Range("B1", Range("B" & Rows.Count).End(xlUp))
  If c Like "Course*" Or c Like "Distance*" Then _
    c.Characters(17).Font.Color = IIf(tout, 16777215, c.Interior.Color)
Next
End Sub

Par ailleurs pour dispatcher les tableaux dans les feuilles :

Code:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim x$, i&
With Sh
  If .Name Like "R#*" Then
    Application.ScreenUpdating = False
    .DrawingObjects.Delete
    Feuil2.Cells.Copy .[A1] 'CodeName
    .[A4].Copy .[A4] 'vide la mémoire
    x = "*R." & Val(Mid(.Name, 2)) & "-*"
    For i = .Cells(.Rows.Count, 2).End(xlUp).Row To 1 Step -1
      If .Cells(i, 2) Like "Course*" And Not .Cells(i, 2) Like x Then
        With .Range(.Cells(i, 2), .Cells(i + 5, 2).CurrentRegion)
          .Resize(.Rows.Count + 4).EntireRow.Delete
        End With
      End If
    Next
    ActiveCell.Select
    With .UsedRange: End With 'actualise la barre de défilement
  End If
End With
End Sub

Tous ces codes sont dans ThisWorkbook, voyez le fichier joint.

Edit : ajouté l'actualisation de la barre de défilement.

A+

job75 · 29 Mars 2016

Re : Garder seulement une partie d'une phrase......

Re,

Perso je préfère de beaucoup remplacer le bouton par les touches de raccourci Ctrl+A :

Code:

Sub Debut_Tout()
'se lance par Ctrl+A
Dim tout As Boolean, c As Range
tout = [B1].Characters(17, 1).Font.Color <> 16777215
Application.ScreenUpdating = False
For Each c In Range("B1", Range("B" & Rows.Count).End(xlUp))
  If c Like "Course*" Or c Like "Distance*" Then _
    c.Characters(17).Font.Color = IIf(tout, 16777215, c.Interior.Color)
Next
End Sub

Fichier (2).

A+

Guido · 29 Mars 2016

Re : Garder seulement une partie d'une phrase......

Re

Bonsoir Job75 et le Forum

Merci pour les deux propositions propositions.

Afin de finaliser le fichier journaliers..je dois tansferer les R1...2...3...4...et 5 dans cinq onglets

different nommé TAB R1...2...3...4 et TAB R5.

Voir les cinq feuils .Merci

Guido

job75 · 29 Mars 2016

Re : Garder seulement une partie d'une phrase......

Re,

Faut pas exagérer Guido, vous allez vous rendre malade 🙄

A+

Effectuez une recherche sur Excel Downloads...

Resolu

Guido

XLDnaute Accro

DoubleZero

XLDnaute Barbatruc

Guido

XLDnaute Accro

eriiic

XLDnaute Barbatruc

Guido

XLDnaute Accro

Pièces jointes

eriiic

XLDnaute Barbatruc

Guido

XLDnaute Accro

eriiic

XLDnaute Barbatruc

Pièces jointes

JCGL

XLDnaute Barbatruc

Guido

XLDnaute Accro

JCGL

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Guido

XLDnaute Accro

Pièces jointes

job75

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée