Resolu

Guido

XLDnaute Accro
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

XLDnaute Barbatruc
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

XLDnaute Accro
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
 

Guido

XLDnaute Accro
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

Re

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

Merci a plus

Guido
 

Pièces jointes

  • Dispacher-de-la-feuil1-vers-different-onglets-pronos-du12.03.2016.Complet..xls
    428 KB · Affichages: 39
  • Dispacher-de-la-feuil1-vers-different-onglets-pronos-du12.03.2016.Complet..xls
    428 KB · Affichages: 52

eriiic

XLDnaute Barbatruc
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
 

JCGL

XLDnaute Barbatruc
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
 
Dernière édition:

Guido

XLDnaute Accro
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

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

Bonjour à tous,

Et pourtant...

A+ à tous
 

Pièces jointes

  • JC Dispacher-de-la-feuil1-vers-different-onglets-pronos-du12.03.2016.Complet..xls
    491 KB · Affichages: 48

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Dispacher-de-la-feuil1-vers-different-onglets-pronos-du12.03.2016.Complet(1).xls
    224 KB · Affichages: 39
Dernière édition:

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Dispacher-de-la-feuil1-vers-different-onglets-pronos-du12.03.2016.Complet(2).xls
    233 KB · Affichages: 37

Guido

XLDnaute Accro
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
 

Pièces jointes

  • Pronos Guido Modele TAB 2016..xls
    272 KB · Affichages: 43

Statistiques des forums

Discussions
314 162
Messages
2 106 601
Membres
109 637
dernier inscrit
lafforest