Questo articolo segue al precedente “Classifica tramite VBA” di cui è un evoluzione.
L’esigenza del nostro lettore era quella di avere la classifica per categoria
in un’unica colonna, dal momento che dovrà gestire fino a 10 categorie contemporaneamente.
Ho modificato quindi il codice permettendo di gestire N categorie contemporaneamente
senza colonne dedicate.
Ecco la versione aggiornata del file:
Riporto il codice commentato :
Private Sub Worksheet_BeforedoubleClick(ByVal Target As Range, Cancel As Boolean)
'individuo ultima riga non vuota
Sheet1.Select
Last_Row = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If Not Intersect(Range(Cells(3, 3), Cells(Last_Row, 3)), Target) Is Nothing Then
If Cells(Target.Row, 2) = "" Then
'inserisco l'ordine nella Classifica Generale
Cells(Target.Row, 1) = Application.Max(Range("A:A")) + 1
'Per il concorrente selezionato individuo il numero di partecipanti
'appartenenti alla stessa categoria
MaxCat = Application.CountIf(Sheet1.Range("D:D"), Sheet1.Cells(Target.Row, 4))
'Riposto la categoria del concorrente selezionato in una colonna d'appoggio
Cells(Target.Row, 5) = Cells(Target.Row, 4)
'Determino quanti partecipanti della categoria del concorrente selezionato sono arrivati
NowInCat = Application.CountIf(Sheet1.Range("E:E"), Sheet1.Cells(Target.Row, 5))
If NowInCat = 0 Then 'Se il numero di cui sopra è zero
Cells(Target.Row, 2) = Cells(Target.Row, 5) & "_1"
'il concorrente selezionato è il primo arrivato
'e quindi riporto categoria e Nr1
Else 'Se il numero di cui sopra maggiore di zero
Cells(Target.Row, 2) = Cells(Target.Row, 5) & "_" & MaxCat - (MaxCat - NowInCat)
'l'ordine di arrivo è dato dal numero di partecipanti appartenenti alla stessa categoria
' meno il numero di partecipanti appartenenti alla stessa categoria da cui sottraggo
'il numero dei gia' arrivati
End If
End If
End If
'Identifico quanti concorrenti sono arrivati (-1 serve per non conteggiare l'intestazione)
nrGenerale = Application.CountA(Sheet1.Range("A:A")) - 1
'se i concorrenti arrivati sono pari al numero dell'ultima riga non vuota
'(-2 serve per non conteggiare l'intestazione e la prima riga che è vuota)
If nrGenerale = Last_Row - 2 Then
MsgBox "Gara terminata!", vbInformation 'allora la gara è terminata
Range(Cells(3, 5), Cells(Last_Row, 5)).ClearContents
Range("A2").Select
End If
Cancel = True
End Sub
Riccardo Vincenti
The following two tabs change content below.
Riccardo Vincenti
Ultimi post di Riccardo Vincenti (vedi tutti)
- 073. Duplicare righe excel modificando il contenuto - 6 Ottobre 2017
- 072. Estrazione numeri casuali - 6 Ottobre 2017
- 071. Estrazione casuale valori da un elenco - 5 Ottobre 2017
- 070. Contare dati univoci senza Pivot - 21 Settembre 2017
- 069. Aggiungere intervalli ad una data: Date Add in Excel - 21 Settembre 2017
This work by Riccardo Vincenti is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International