013. Classifica tramite VBA

Download PDF

Domanda:

Salve ho un problema da risolvere.
ho un foglio excel dove ricavo una classifica generale  di arrivo dando la posizione con un doppio click che mi inserisce via via la numerazione di classifica utilizzando quasta formula vba

Private Sub Worksheet_BeforedoubleClick( ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Range("c3:c65536"),Target) Is Nothing Then
 If Cells(Target.Row, 1) = "" Then
 Cells(Target.Row, 1) = Application.Max(Range("a:a")) + 1
 End If
 End If
 Cancel = True
 End Sub

fino a qui tutto ok.

il problema è che vorrei sempre con doppio click oltre a fare la classifica generale di arrivo farla contemporaneamente per categoria.

esempio
Classifica  Nominativo   ClassificaCategoria    Categoria
1                             1                    a2
2                             1                    a1
3                             2                    a2
4                             3                    a2
5                             2                    a1
6                             3                    a1
7                             4                    a2

é possibile tutto ciò???

Risposta:

ho modificato la sua tabella in:
ClassificaGenerale | ClassificaCategoriaA1 | ClassificaCategoriaA2 | Nominativo | Categoria
A a1
B a1
C a1
D a2
E a2
F a2

Ho modificato il suo codice in:

Private Sub Worksheet_BeforedoubleClick(ByVal Target As Range, Cancel As Boolean)
 'Identifico l'ultima cella non vuota del foglio
Last_Row = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 'quando clicca su di un nominativo nella colonna D (colonna 4)

If Not Intersect(Range(Cells(3, 4), Cells(Last_Row, 4)), Target) Is Nothing Then
   If Cells(Target.Row, 1) = "" Then
         Cells(Target.Row, 1) = Application.Max(Range("A:A)) + 1
         'Categoria a1
         If Cells(Target.Row, 5) = "a1" Then
             Cells(Target.Row, 2) = Application.Max(Range("B:B")) + 1
             'Categoria a2
         ElseIf Cells(Target.Row, 5) = "a2" Then
             Cells(Target.Row, 3) = Application.Max(Range("C:C")) + 1
        End If
   End If
End If
Cancel = True
End Sub

In allegato il file d’esempio
Classifica

Riccardo Vincenti

The following two tabs change content below.