Titre du sujet : Re: Récupération données PMU
par Mytå le 26/09/2011 22:48:27
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å
|
Didier FOURGEOT