Dim Squadre(1 To 20) As String
Dim Punti(1 To 20) As Integer
Dim Giocate(1 To 20) As Integer
Dim Vinte(1 To 20) As Integer
Dim Pareggiate(1 To 20) As Integer
Dim Perse(1 To 20) As Integer
Dim RetiFatte(1 To 20) As Integer
Dim RetiSubite(1 To 20) As Integer
Dim GoalsOspitanteAndata As Integer
Dim GoalsOspitataAndata As Integer
Dim GoalsOspitanteRitorno As Integer
Dim GoalsOspistataRitorno As Integer
Dim IDOspitante As Integer
Dim IDOspitata As Integer
Dim currentDate As Date
Sub Macro1()
'
' Macro1 Macro
' Macro registrata il 09/02/2007 da Maurizio
'
' Scelta rapida da tastiera: CTRL+MAIUSC+P
'
Dim J As Integer
Dim strDt As String
Dim Riga As Integer
Dim Andata As Boolean
Sheets("Calendario").Select
strDt = CStr(Cells(ActiveCell.Row, ActiveCell.Column))
currentDate = CDate(strDt)
If IsDate(strDt) = False Then
MsgBox "Posizionare il cursore sulla data!"
Exit Sub
End If
'For J = 1 To 20
' Squadre(J) = Sheets("Squadre").Cells(J + 1, 1)
'Next
For J = 1 To 20
Punti(J) = 0
Giocate(J) = 0
Vinte(J) = 0
Pareggiate(J) = 0
Perse(J) = 0
RetiFatte(J) = 0
RetiSubite(J) = 0
Next
Riga = ActiveCell.Row + 1
If ActiveCell.Row = 1 Then
MsgBox "Selezionare una riga valida!", vbCritical
Else
Do While Riga < ActiveCell.Row + 11
' se la data è in colonna 2 si tratta dell'ANDATA
' altrimenti del RITORNO !
If ActiveCell.Column = 2 Then
' ANDATA
Andata = True
If (IsEmpty(Cells(Riga, 1)) = False And IsEmpty(Cells(Riga, 2)) = False) Then
GoalsOspitanteAndata = Cells(Riga, 1)
GoalsOspitataAndata = Cells(Riga, 2)
IDOspitante = Cells(Riga, 3)
IDOspitata = Cells(Riga, 4)
GoSub AggiornaAndata
End If
Else
' RITORNO
Andata = False
If (IsEmpty(Cells(Riga, 5)) = False And IsEmpty(Cells(Riga, 6)) = False) Then
GoalsOspitanteRitorno = Cells(Riga, 5)
GoalsOspitataRitorno = Cells(Riga, 6)
IDOspitante = Cells(Riga, 3)
IDOspitata = Cells(Riga, 4)
GoSub AggiornaRitorno
End If
End If
Riga = Riga + 1
Loop
Call AggiornaClassifica
Sheets("Calendario").Select
If Andata Then
ActiveSheet.Cells(Riga + 1, 2).Select
Else
ActiveSheet.Cells(Riga + 1, 6).Select
End If
MsgBox "La classifica alla data del: " & strDt & " è stata aggiornata!", vbInformation
End If
Exit Sub
AggiornaAndata:
Giocate(IDOspitante) = Giocate(IDOspitante) + 1
Giocate(IDOspitata) = Giocate(IDOspitata) + 1
RetiFatte(IDOspitante) = RetiFatte(IDOspitante) + GoalsOspitanteAndata
RetiSubite(IDOspitata) = RetiSubite(IDOspitata) + GoalsOspitanteAndata
RetiFatte(IDOspitata) = RetiFatte(IDOspitata) + GoalsOspitataAndata
RetiSubite(IDOspitante) = RetiSubite(IDOspitante) + GoalsOspitataAndata
If GoalsOspitanteAndata > GoalsOspitataAndata Then
Punti(IDOspitante) = Punti(IDOspitante) + 3
Punti(IDOspitata) = Punti(IDOspitata) + 0
Vinte(IDOspitante) = Vinte(IDOspitante) + 1
Perse(IDOspitata) = Perse(IDOspitata) + 1
ElseIf GoalsOspitanteAndata < GoalsOspitataAndata Then
Punti(IDOspitante) = Punti(IDOspitante) + 0
Punti(IDOspitata) = Punti(IDOspitata) + 3
Perse(IDOspitante) = Perse(IDOspitante) + 1
Vinte(IDOspitata) = Vinte(IDOspitata) + 1
Else
' pareggio
Punti(IDOspitante) = Punti(IDOspitante) + 1
Punti(IDOspitata) = Punti(IDOspitata) + 1
Pareggiate(IDOspitante) = Pareggiate(IDOspitante) + 1
Pareggiate(IDOspitata) = Pareggiate(IDOspitata) + 1
End If
Return
AggiornaRitorno:
Giocate(IDOspitante) = Giocate(IDOspitante) + 1
Giocate(IDOspitata) = Giocate(IDOspitata) + 1
RetiFatte(IDOspitante) = RetiFatte(IDOspitante) + GoalsOspitanteRitorno
RetiSubite(IDOspitata) = RetiSubite(IDOspitata) + GoalsOspitanteRitorno
RetiFatte(IDOspitata) = RetiFatte(IDOspitata) + GoalsOspitataRitorno
RetiSubite(IDOspitante) = RetiSubite(IDOspitante) + GoalsOspitataRitorno
If GoalsOspitanteRitorno > GoalsOspitataRitorno Then
Punti(IDOspitante) = Punti(IDOspitante) + 3
Punti(IDOspitata) = Punti(IDOspitata) + 0
Vinte(IDOspitante) = Vinte(IDOspitante) + 1
Perse(IDOspitata) = Perse(IDOspitata) + 1
ElseIf GoalsOspitanteRitorno < GoalsOspitataRitorno Then
Punti(IDOspitante) = Punti(IDOspitante) + 0
Punti(IDOspitata) = Punti(IDOspitata) + 3
Perse(IDOspitante) = Perse(IDOspitante) + 1
Vinte(IDOspitata) = Vinte(IDOspitata) + 1
Else
' pareggio
Punti(IDOspitante) = Punti(IDOspitante) + 1
Punti(IDOspitata) = Punti(IDOspitata) + 1
Pareggiate(IDOspitante) = Pareggiate(IDOspitante) + 1
Pareggiate(IDOspitata) = Pareggiate(IDOspitata) + 1
End If
Return
End Sub
Private Sub AggiornaClassifica()
Sheets("Squadre").Select
For J = 2 To 21
Cells(J, 2) = Cells(J, 2) + Punti(J - 1)
Cells(J, 3) = Cells(J, 3) + Giocate(J - 1)
Cells(J, 4) = Cells(J, 4) + Vinte(J - 1)
Cells(J, 5) = Cells(J, 5) + Pareggiate(J - 1)
Cells(J, 6) = Cells(J, 6) + Perse(J - 1)
Cells(J, 7) = Cells(J, 7) + RetiFatte(J - 1)
Cells(J, 8) = Cells(J, 8) + RetiSubite(J - 1)
Next
ActiveSheet.Cells(1, 1) = Format(currentDate, "MM-DD-YYYY")
' ORA OCCORRE METTERE IN ORDINE LE SQUADRE PER PUNTI DESCRESCENTE E
' TENERE CONTO DEI PUNTI DI PENALIZZAZIONE (COLONNA 9)
Sheets("Squadre").Select
currentDate = Cells(1, 1)
Range("A2:I21").Select
Selection.Copy
Sheets("Classifica").Select
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Cells(1, 1) = currentDate
For J = 2 To 21
Cells(J, 2) = Cells(J, 2) + Cells(J, 9)
Next
Range("A2:I21").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
Bookmarks