Option Explicit
Sub ViderTexteBrut()
'Vider la feuille à l'exeption de la 1ère ligne occupée
With Sh_PageComplèteBrute
If .UsedRange.Rows.Count > 1 Then .UsedRange.Resize(.UsedRange.Rows.Count - 1).Offset(1).Clear
Application.Goto .Range("A2")
End With
End Sub
Sub Extraction_Classement_Calendrier()
Dim TexteBrut, Saison As String, i As Long, Idx As Long, Lgn1 As Long, LgnFin As Long
Dim NbEq As Byte, NbMatchs As Integer, NbJournées As Byte
Dim Tb_Clasmt(), Tb_Calendrier(), lgn As Integer
Dim DC As Object, Journée As Byte, DateJ As Double
'L'ensemble des données dans la variable tableau "TexteBrut"
With Sh_PageComplèteBrute
If .UsedRange.Rows.Count < 2 Then Exit Sub
TexteBrut = .Cells(1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 7).Value
End With
'Détecter la saison :
Saison = ""
i = 1
While Not TexteBrut(i, 1) Like "##.##.####" And i < UBound(TexteBrut, 1)
i = i + 1
Wend
Saison = Right(TexteBrut(i, 1), 4) & "-" & CInt(Right(TexteBrut(i, 1), 4)) + 1
'Extraire le classement
With WorksheetFunction
Idx = .Match("Classement", .Index(TexteBrut, 0, 1), 0)
End With
'début et fin du classement
Lgn1 = 0
For i = Idx To UBound(TexteBrut)
If TexteBrut(i, 1) = 1 Then Lgn1 = i
If IsNumeric(TexteBrut(i, 1)) And Lgn1 > 0 Then LgnFin = i
If Not IsNumeric(TexteBrut(i, 1)) And Lgn1 > 0 Then Exit For
Next
'constantes du championnat
NbEq = LgnFin - Lgn1 + 1 'Nbre d'équipes dans le championnat
NbMatchs = NbEq * (NbEq - 1) 'Nbre de Matchs dans le championnat
NbJournées = (NbEq - 1) * 2 'Nbre de journées du championnat
'chargement du tableau de classement
ReDim Tb_Clsmt(1 To NbEq, 1 To 8)
lgn = 0
For i = Lgn1 To LgnFin
lgn = lgn + 1
Tb_Clsmt(lgn, 1) = Saison 'Saison extraite
Tb_Clsmt(lgn, 2) = CByte(TexteBrut(i, 1)) 'Rang
Tb_Clsmt(lgn, 3) = TexteBrut(i, 2) 'Equipe
Tb_Clsmt(lgn, 4) = CByte(TexteBrut(i, 4)) 'Matchs joués
Tb_Clsmt(lgn, 5) = CInt(TexteBrut(i, 5)) * 24 + Hour(TexteBrut(i, 5)) 'Buts Pour
Tb_Clsmt(lgn, 6) = Minute(TexteBrut(i, 5)) 'Buts Contre
Tb_Clsmt(lgn, 7) = CInt(TexteBrut(i, 6)) 'Différence de buts
Tb_Clsmt(lgn, 8) = CInt(TexteBrut(i, 7)) 'Points
Next
'RàZ du TS et copie des données extraite
With sh_Extraction.[ts_Classement]
.Offset(1).Clear
.ListObject.Resize .ListObject.Range.Resize(2) 'ces deux lignes pour préserver
.ListObject.Resize .ListObject.Range.Resize(UBound(Tb_Clsmt, 1) + 1) 'le format de la 1ère ligne
End With
sh_Extraction.[ts_Classement].Value = Tb_Clsmt
'Extraire le calendrier (avec le résultat des matchs déjà joués)
'recherche du début
With WorksheetFunction
Idx = .Match("Journée 1", .Index(TexteBrut, 0, 1), 0)
End With
'Dictionnaire Equipe-Nbre de matchs joués
Set DC = CreateObject("Scripting.dictionary") 'Dictionnaire du nombre de matchs joués
For i = 1 To NbEq
DC(Tb_Clsmt(i, 3)) = Tb_Clsmt(i, 4)
Next
'dimensions du tableau
ReDim Tb_Calendrier(1 To NbMatchs, 1 To 8)
'Extraction des données
lgn = 0
For i = Idx To UBound(TexteBrut, 1)
Select Case True
Case TexteBrut(i, 1) Like "Journée *" 'La ligne lue indique une journée
Journée = CInt(Replace(TexteBrut(i, 1), "Journée ", ""))
Case TexteBrut(i, 1) Like "##.##.####" 'La ligne lue indique la date
DateJ = DateValue(Replace(TexteBrut(i, 1), ".", "/"))
Case DC.Exists(TexteBrut(i, 1)) 'La ligne lue est l'équipe à domicile
lgn = lgn + 1 'Charger le tableau avec les données du bloc de 5 lignes
Tb_Calendrier(lgn, 1) = Saison
Tb_Calendrier(lgn, 2) = Journée
Tb_Calendrier(lgn, 3) = TexteBrut(i, 1)
Tb_Calendrier(lgn, 6) = TexteBrut(i + 4, 1)
Tb_Calendrier(lgn, 7) = DateJ
If Journée <= DC(TexteBrut(i, 1)) Then
'Score (à cause du séparateur : il est lu comme une date
Tb_Calendrier(lgn, 4) = CInt(TexteBrut(i + 2, 1)) * 24 + Hour(TexteBrut(i + 2, 1))
Tb_Calendrier(lgn, 5) = Minute(TexteBrut(i + 2, 1))
Else
'Heure ou -:-
Tb_Calendrier(lgn, 8) = TexteBrut(i + 2, 1)
End If
i = i + 4 'Pour passer au bloc suivant
Case Else
Exit For
End Select
Next
'RàZ du TS et copie des données extraite
With sh_Extraction.[Ts_Calendrier]
.Offset(1).Clear
.ListObject.Resize .ListObject.Range.Resize(2) 'ces deux lignes pour préserver
.ListObject.Resize .ListObject.Range.Resize(UBound(Tb_Calendrier, 1) + 1) 'le format de la 1ère ligne
End With
sh_Extraction.[Ts_Calendrier].Value = Tb_Calendrier
Application.Goto sh_Extraction.[A1]
End Sub
