Option Explicit
Sub Importation_Journée(Nom As String)
'
Dim NumeroJournee As Integer
Dim JoueursJournee As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim NomJoueur As String
Dim NbreJoueursTotal, NJ, N1, NN, N2 As Integer
Dim ColonneJoueur As Integer
'
' Sélection de la feuille
Nom = Split(Nom, "\")(UBound(Split(Nom, "\")))
Windows(Nom).Activate
' Rajout des deux calculs
Cells(4, 1).Select
ActiveCell.FormulaR1C1 = _
"=VALUE(IF(RIGHT(LEFT(R[-1]C,14))=""e"",RIGHT(LEFT(R[-1]C,13)),RIGHT(LEFT(R[-1]C,14),2)))"
Cells(7, 1).Select
ActiveCell.FormulaR1C1 = "=VALUE(LEFT(R[-1]C,2))"
NumeroJournee = Cells(4, 1).Value
JoueursJournee = Cells(7, 1).Value
Cells(4, 1).Value = ""
Cells(7, 1).Value = ""
' Suppression des bordures
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
' Suppression du fusionnage
Selection.UnMerge
' Sélection des matchs de la journée
Range("B9:C18").Select
Selection.Copy
' Copie dans le classeur
Windows("Classeur L1 2008-2009").Activate
Cells(6 + 18 * (NumeroJournee - 1), 2).Select
ActiveSheet.Paste
' Sélection d'un joueur
For i = 1 To JoueursJournee
Windows(Nom).Activate
NomJoueur = Cells(8, 8 + 4 * (i - 1))
' Savoir si le joueur existe déjà ou pas
NbreJoueursTotal = Workbooks("Classeur L1 2008-2009").Worksheets("Feuil1").Range("B1").Value
k = 1
Do While k < NbreJoueursTotal + 1
If Workbooks("Classeur L1 2008-2009").Worksheets("Feuil1").Cells(4, 15 + 3 * (k - 1)).Value = NomJoueur Then
ColonneJoueur = 15 + 3 * (k - 1)
Exit Do
Else
k = k + 1
End If
Loop
' Copie du nom du joueur
If k = NbreJoueursTotal + 1 Then
ColonneJoueur = 15 + 3 * NbreJoueursTotal
Cells(8, 8 + 4 * (i - 1)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Classeur L1 2008-2009").Activate
Cells(4, ColonneJoueur).Select
ActiveSheet.Paste
' Fusionnage des cellules
Range(Cells(4, ColonneJoueur), Cells(4, ColonneJoueur + 2)).Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
' Copie des votes du joueur
Windows(Nom).Activate
Range(Cells(9, 8 + 4 * (i - 1)), Cells(18, 9 + 4 * (i - 1))).Select
Selection.Copy
Windows("Classeur L1 2008-2009").Activate
Cells(6 + 18 * (NumeroJournee - 1), ColonneJoueur).Select
ActiveSheet.Paste
Else
Windows(Nom).Activate
Range(Cells(9, 8 + 4 * (i - 1)), Cells(18, 9 + 4 * (i - 1))).Select
Selection.Copy
Windows("Classeur L1 2008-2009").Activate
Cells(6 + 18 * (NumeroJournee - 1), ColonneJoueur).Select
ActiveSheet.Paste
End If
Next i
End Sub
Sub Remplissage()
Dim i As Integer, j As Integer, k As Integer
For i = 1 To 38
For k = 1 To 50
Cells(16 + 18 * (i - 1), 17 + 3 * (k - 1)).FormulaR1C1 = "=IF(COUNTBLANK(R[-10]C:R[-1]C)=10,"""";Bonus(R[-10]C:R[-1]C)"
Next i
End Sub
Public Function NbJoueurs(Li As Range)
Dim i As Integer, R As Integer, N As Integer
NbJoueurs = 0
R = Li.Row
For i = 1 To 50
If Cells(R, 15 + 3 * (i - 1)).Value <> "" Then
NbJoueurs = NbJoueurs + 1
End If
Next i
If NbJoueurs = 0 Then
NbJoueurs = ""
End If
End Function
Public Function Nb1(Li As Range)
Dim i As Integer, R As Integer
Nb1 = 0
R = Li.Row
If Cells(R, 7) = "" Then
Nb1 = ""
Else
For i = 1 To 50
If Cells(R, 15 + 3 * (i - 1)).Value > Cells(R, 16 + 3 * (i - 1)).Value Then
Nb1 = Nb1 + 1
End If
Next i
Nb1 = Nb1 / Cells(R, 7)
End If
End Function
Public Function NbN(Li As Range)
Dim i As Integer, R As Integer
NbN = 0
R = Li.Row
If Cells(R, 7) = "" Then
NbN = ""
Else
For i = 1 To 50
If Cells(R, 15 + 3 * (i - 1)).Value = Cells(R, 16 + 3 * (i - 1)).Value And Cells(R, 15 + 3 * (i - 1)).Value <> "" Then
NbN = NbN + 1
End If
Next i
NbN = NbN / Cells(R, 7)
End If
End Function
Public Function NB2(Li As Range)
Dim i As Integer, R As Integer
NB2 = 0
R = Li.Row
If Cells(R, 7) = "" Then
NB2 = ""
Else
For i = 1 To 50
If Cells(R, 15 + 3 * (i - 1)).Value < Cells(R, 16 + 3 * (i - 1)).Value Then
NB2 = NB2 + 1
End If
Next i
NB2 = NB2 / Cells(R, 7)
End If
End Function
Public Function Bonus1N2(i As Variant, j As Double, k As Double)
Dim a As String, b As String, c As String
If i <> 0 And i < 0.2 Then
a = "1"
Else
a = "-"
End If
If j <> 0 And j < 0.2 Then
b = "N"
Else
b = "-"
End If
If k <> 0 And k < 0.2 Then
c = "2"
Else
c = "-"
End If
Bonus1N2 = a & b & c
End Function
Public Function Points(ProDom, ProExt, Ligne)
Dim ScoDom, ScoExt, B1, BN, B2 As Variant
ScoDom = Cells(Ligne.Row, 4).Value
ScoExt = Cells(Ligne.Row, 5).Value
B1 = Cells(Ligne.Row, 8).Value
BN = Cells(Ligne.Row, 9).Value
B2 = Cells(Ligne.Row, 10).Value
If ProDom = "" Or ProExt = "" Then
Points = ""
Else
If ScoDom = "" Or ScoExt = "" Then
Points = ""
Else
If ((ProDom - ProExt) * (ScoDom - ScoExt) < 0) Or (ProDom = ProExt And ScoDom <> ScoExt) Or (ProDom <> ProExt And ScoDom = ScoExt) Then
Points = 0
Else
If ProDom <> ScoDom Or ProExt <> ScoExt Then
Points = 1
Else
Select Case ProDom
Case Is > 3: Points = 5
Case 3
Select Case ProExt
Case Is > 1: Points = 5
Case Else: Points = 4
End Select
Case 2
Select Case ProExt
Case Is > 2: Points = 5
Case 2: Points = 4
Case Else: Points = 3
End Select
Case 1
Select Case ProExt
Case Is > 2: Points = 5
Case 2: Points = 4
Case Else: Points = 2
End Select
Case 0
Select Case ProExt
Case Is > 2: Points = 5
Case 2: Points = 4
Case 1: Points = 3
Case 0: Points = 2
End Select
End Select
End If
If (ProDom > ProExt And B1 < 0.1) Or (ProDom = ProExt And BN < 0.1) Or (ProDom < ProExt And B2 < 0.1) Then
Points = Points + 2
ElseIf (ProDom > ProExt And B1 < 0.2) Or (ProDom = ProExt And BN < 0.2) Or (ProDom < ProExt And B2 < 0.2) Then
Points = Points + 1
End If
End If
End If
End If
End Function
Public Function NbVainqueurs(Ligne)
Dim i As Integer
Dim ScoDom As Variant
Dim ScoExt As Variant
ScoDom = Cells(Ligne.Row, 4).Value
ScoExt = Cells(Ligne.Row, 5).Value
If ScoDom = "" Or ScoExt = "" Then
NbVainqueurs = ""
Else
NbVainqueurs = 0
For i = 1 To 50
If (Cells(Ligne.Row, 15 + 3 * (i - 1)).Value > Cells(Ligne.Row, 16 + 3 * (i - 1)) And ScoDom > ScoExt) Or (Cells(Ligne.Row, 15 + 3 * (i - 1)).Value = Cells(Ligne.Row, 16 + 3 * (i - 1)) And ScoDom = ScoExt) Or (Cells(Ligne.Row, 15 + 3 * (i - 1)).Value < Cells(Ligne.Row, 16 + 3 * (i - 1)) And ScoDom < ScoExt) Then
NbVainqueurs = NbVainqueurs + 1
End If
Next i
End If
End Function
Public Function Bonus(Votes As Range)
Dim i As Integer
Bonus = 0
For i = 1 To 10
If
End Function
) ou bien je fais amende honorable mais il faut un ordi de la NASA pour faire tes calculs...
