Salve a tutti,
L'altro giorno, avendo bisogno di gestire una classifica e volenod che questa si autoaggiornasse, ho cercato una qualche guida. Ne ho trovata una per campionati a 20 squadre, e ho cercato di adattarlo ad un campionato a 11 squadre.
Devo aggiustare l'ultima macro, per l'aggiornamento classifica, e non ne sono in grado, chi riesce?
(questo è il tutorial, spero non sia spam, se lo è rimuovete pure il link: http://www.mc2elearning.com/campiona...con-excel.html )

E questo è il codice vba per l'aggiornamento classifiche del campionato a 20 squadre:

(Mi dispiace non averlo potuto mettere nel quote ma toglieva gli a capo)

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