Récupération données PMU
#1
Régulier XLPages

Inscription: 25/09/2011

Messages: 54

Système d'exploitation:
PC
Version Excel utilisée:
2007
Posté le : 25-09-2011 19h04

Bonjour,

Voici la "musique" d'un cheval au Turf qui représente les performances sur sa carrière:

(10) 1s 7h (09) 7h 2s 1p (08) 1s                 (10) (09) (08) représentent l'année.

Il faudrait que je récupère uniquement ceci:   1 7 7 2 1 1   il faut supprimer les parenthèses et les chiffres inclus.

J'ai ce code VBA :

'Musique !

        V = Replace(FSource.Cells(LigneSourceEnCours + 3, 2).Text, "(10) ", "")

        TabTemp = Split(V, " ")

        For Col = 0 To Application.Min(UBound(TabTemp) - 1, 5) 'les 6 premières courses seulement

            With FCible.Cells(LigneCibleEnCours, Col + 7)
Bien entendu seul (10) est supprimé,

Je voudrais supprimer (09) et (08) . Avez-vous une idée?

Merci.



Edité par turfman le 01/10/2011 17:43:48
Hors Ligne
Rapport   Haut 

Re: Récupération données PMU
#2
Accro XLPages

Inscription: 17/08/2007
De Québec, Canada

Messages: 180

Système d'exploitation:
PC
Version Excel utilisée:
Excel 2003, 2007 (FR) & MsProject 2003
Posté le : 25-09-2011 21h59
Salut le forum

Utilise une fonction
Function Sans_Parenthese(V As String) As String
Dim I As Byte
Dim Tablo
 
  Tablo = Array("(07)", "(08)", "(09)", "(10)")
     
  For I = 0 To UBound(Tablo)
    V = Replace(V, Tablo(I), "")
  Next I
 
Sans_Parenthese = Application.WorksheetFunction.Trim(V)

End Function

Mytå






Edité par Mytå le 25/09/2011 22:41:13
Hors Ligne
Rapport   Haut 

Re: Récupération données PMU
#3
Régulier XLPages

Inscription: 25/09/2011

Messages: 54

Système d'exploitation:
PC
Version Excel utilisée:
2007
Posté le : 25-09-2011 23h56
Option Explicit
' Auteur    : Didier FOURGEOT (myDearFriend!)  -  www.mdf-xlpages.com

Sub RecupValeurs()
Dim FSource As Worksheet, FCible As Worksheet
Dim LigneSourceEnCours As Long, LigneCibleEnCours As Long
Dim V As Variant, TabTemp As Variant
Dim Col As Byte

    Set FSource = Sheets("Partants")
    Set FCible = Sheets("CalculValeur")
    LigneSourceEnCours = 16
    LigneCibleEnCours = 2
    FCible.Range("B2:L21").ClearContents
    Do
   
        V = FSource.Cells(LigneSourceEnCours, 2).Value
        FCible.Cells(LigneCibleEnCours, 2) = IIf(Val(V) > 0, V, 0)
        V = FSource.Cells(LigneSourceEnCours + 1, 2).Value
        FCible.Cells(LigneCibleEnCours, 3) = IIf(Val(V) > 0, V, 0)
        V = FSource.Cells(LigneSourceEnCours + 2, 2).Value
        FCible.Cells(LigneCibleEnCours, 4) = IIf(Val(V) > 0, V, 0)
       
        V = FSource.Cells(LigneSourceEnCours + 7, 2).Value
        If Val(V) > 0 Then FCible.Cells(LigneCibleEnCours, 5) = V
        V = FSource.Cells(LigneSourceEnCours + 4, 2).Value
        If Val(V) > 0 Then FCible.Cells(LigneCibleEnCours, 6) = V

        'Musique !
        V = Replace(FSource.Cells(LigneSourceEnCours + 3, 2).Text, "(10) ", "")
        TabTemp = Split(V, " ")
        For Col = 0 To Application.Min(UBound(TabTemp) - 1, 5)  'les 6 premières courses seulement
            With FCible.Cells(LigneCibleEnCours, Col + 7)
                .Value = Left(TabTemp(Col), 1)
                 .HorizontalAlignment = xlCenter
            End With
        Next Col
       
        'On passe au cheval suivant
        LigneSourceEnCours = LigneSourceEnCours + 23
        LigneCibleEnCours = LigneCibleEnCours + 1
       
    Loop Until FSource.Cells(LigneSourceEnCours, 2) = ""
End Sub
 
je te remercie infiniment mais ou mettre ta fonction.
Voici la page de code ( oeuvre de Didier) dans laquelle il supprimait uniquement (10) . Il faudrait rajouter (09) (08)

 V = Replace(FSource.Cells(LigneSourceEnCours + 3, 2).Text, "(10) ", "")
Merci



Hors Ligne
Rapport   Haut 

Re: Récupération données PMU
#4
Accro XLPages

Inscription: 17/08/2007
De Québec, Canada

Messages: 180

Système d'exploitation:
PC
Version Excel utilisée:
Excel 2003, 2007 (FR) & MsProject 2003
Posté le : 26-09-2011 03h38
 Re le forum

Tu colles ma fonction dans un module et dans ton programme
V=Sans_Parenthese(FSource.Cells(LigneSourceEnCours + 3, 2).Text)

Mytå

Hors Ligne
Rapport   Haut 

Re: Récupération données PMU
#5
Régulier XLPages

Inscription: 25/09/2011

Messages: 54

Système d'exploitation:
PC
Version Excel utilisée:
2007
Posté le : 26-09-2011 12h22

Bonjour Myta,

Merci infiniment de t'intéresser à ce problème, mais hélas  ça ne marche pas.

Si tu veux voir de plus près je te joins le fichier. Essaie date 24092011-> maj liste->choisir course ->(Auteuil  Hunorisk) -> import détail Partants-> calcul valeur -> j'ai surligné le cheval 12 il faut donc supprimer (09)(08) pour avoir dans calcvaleur 7 2 1 1 6 1 1

Certaines fois il peut y avoir (10)(09)(08)

Cordialement.

Turfman.

 



Pièce jointe:
zip Récup données courses.zip   [ Taille: 49.94 Ko - Téléchargements: 1246 ]
Hors Ligne
Rapport   Haut 

Re: Récupération données PMU
#6
Accro XLPages

Inscription: 17/08/2007
De Québec, Canada

Messages: 180

Système d'exploitation:
PC
Version Excel utilisée:
Excel 2003, 2007 (FR) & MsProject 2003
Posté le : 26-09-2011 22h48
 Salut le forum

La seule erreur est la course #3
3.WALHBERG
Performances (10) 1h


Le code
Sub RecupValeurs()
Dim FSource As Worksheet, FCible As Worksheet
Dim LigneSourceEnCours As Long, LigneCibleEnCours As Long
Dim V As Variant, TabTemp As Variant
Dim Col As Byte

    Set FSource = Sheets("Partants")
    Set FCible = Sheets("CalculValeur")
    LigneSourceEnCours = 16
    LigneCibleEnCours = 2
    FCible.Range("B2:L21").ClearContents
    Do
   
        V = FSource.Cells(LigneSourceEnCours, 2).Value
        FCible.Cells(LigneCibleEnCours, 2) = IIf(Val(V) > 0, V, 0)
        V = FSource.Cells(LigneSourceEnCours + 1, 2).Value
        FCible.Cells(LigneCibleEnCours, 3) = IIf(Val(V) > 0, V, 0)
        V = FSource.Cells(LigneSourceEnCours + 2, 2).Value
        FCible.Cells(LigneCibleEnCours, 4) = IIf(Val(V) > 0, V, 0)
       
        V = FSource.Cells(LigneSourceEnCours + 7, 2).Value
        If Val(V) > 0 Then FCible.Cells(LigneCibleEnCours, 5) = V
        V = FSource.Cells(LigneSourceEnCours + 4, 2).Value
        If Val(V) > 0 Then FCible.Cells(LigneCibleEnCours, 6) = V

        'Musique !
        V = Sans_Parenthese(FSource.Cells(LigneSourceEnCours + 3, 2).Text)
        TabTemp = Split(V, " ")
        For Col = 0 To Application.Min(UBound(TabTemp) - 1, 5)  'les 6 premières courses seulement
            With FCible.Cells(LigneCibleEnCours, Col + 7)
                .Value = Left(TabTemp(Col), 1)
                 .HorizontalAlignment = xlCenter
            End With
        Next Col
       
        'On passe au cheval suivant
        LigneSourceEnCours = LigneSourceEnCours + 23
        LigneCibleEnCours = LigneCibleEnCours + 1
       
    Loop Until FSource.Cells(LigneSourceEnCours, 2) = ""
End Sub

Function Sans_Parenthese(V As String) As String
Dim I As Byte
Dim Tablo
 
  Tablo = Array("(07)", "(08)", "(09)", "(10)")
     
  For I = 0 To UBound(Tablo)
    V = Replace(V, Tablo(I), "")
  Next I
 
Sans_Parenthese = Application.WorksheetFunction.Trim(V)

End Function

Mytå 
  
Hors Ligne
Rapport   Haut 

Re: Récupération données PMU
#7
Régulier XLPages

Inscription: 25/09/2011

Messages: 54

Système d'exploitation:
PC
Version Excel utilisée:
2007
Posté le : 26-09-2011 23h21
Bonjour Myta,
Peux tu nous renvoyer le classeur avec le nouveau code, ce serait sympa.
Cordialement. 
Hors Ligne
Rapport   Haut 

Re: Récupération données PMU
#8
Accro XLPages

Inscription: 17/08/2007
De Québec, Canada

Messages: 180

Système d'exploitation:
PC
Version Excel utilisée:
Excel 2003, 2007 (FR) & MsProject 2003
Posté le : 27-09-2011 00h54
Re le forum

Fichier en pièce jointe

Mytå 

Pièce jointe:
zip Turf.zip   [ Taille: 50.79 Ko - Téléchargements: 1373 ]
Hors Ligne
Rapport   Haut 

Re: Récupération données PMU
#9
Régulier XLPages

Inscription: 25/09/2011

Messages: 54

Système d'exploitation:
PC
Version Excel utilisée:
2007
Posté le : 27-09-2011 02h42
Salut Myta,
Super! tu es trop fort, depuis le temps qu'on galère la dessus !
Merci infiniment.
Hors Ligne
Rapport   Haut 

Récupération données PMU
#10
Aspirant XLPages

Inscription: 16/02/2011

Messages: 24

Système d'exploitation:
PC
Version Excel utilisée:
2003, 2007
Posté le : 16-02-2012 15h07
Bonjour

Je m'interessait à une époque à ce fichier, et j'avais laissé tomber. Par contre, je recommence à m'y intéresser, j'ai regardé un peu les macro et les différentes feuilles VB, mais il semblerait que les liens ne soient plus exacts.

Je n'arrive pas à refaire moi-même, auriez-vous la gentillesse de remettre à jour les liens ?
Je vous joins le fichier que j'avais, qui ressemble beaucoup à celui-ci.

Merci à vous.

Désolé, j'apprends encore beaucoup de choses, mais là, j'ai pris le fichier et refaire de moi-même, c'est diffcile car je vois pas toujours à quoi sont rattachés certains éléments..
Pièce jointe:
xlsm calculvaleur.xlsm   [ Taille: 63.67 Ko - Téléchargements: 1084 ]
Hors Ligne
Rapport   Haut 


Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.

[Recherche avancée]


Qui consulte actuellement ce sujet ?   1 Utilisateur(s) anonymes