Allora...
In Foglio2 (o altro foglio a piacere), copia da A2 verso il basso l' elenco dei nominativi; idem da B1 verso destra (puoi copiare l' elenco creato in colonna A e poi fare Incolla speciale /Valori + Trasponi).
Sono le "Intestazioni" della tabella da compilare.
Copia poi in un Modulo standard del vba (es Modulo1) la seguente macro:
- Codice: Seleziona tutto
Sub CrossInd()
'
Dim TopRow As String, ShList As String, ShCross As String
Dim I As Long, LastR As Long, J As Long, K As Long, L As Long, myVARR
Dim myX As String, myY As String, myXVal As Long, myYVal As Long
'
ShList = "Foglio1" '<< Il foglio con le squadre
TopRow = "F1:K1" '<< La prima riga dell' elenco squadre
ShCross = "Foglio2" '<< Il foglio dove sara' preparato il cross-index
'
Sheets(ShCross).Cells(2, 2).Resize(Rows.Count - 2, Columns.Count - 2).ClearContents
LastR = Sheets(ShList).Range(TopRow).Range("A1").End(xlDown).Row
myVARR = Sheets(ShList).Range(TopRow).Resize(LastR).Value
For J = 2 To Sheets(ShCross).Range("B1").End(xlToRight).Column
For K = 2 To Sheets(ShCross).Range("A2").End(xlDown).Row
myX = Sheets(ShCross).Cells(1, J)
myY = Sheets(ShCross).Cells(K, 1)
For I = 0 To LastR - 1
myXVal = 0: myYVal = 0
If myX <> myY Then
For L = 0 To Range(TopRow).Columns.Count - 1
If myVARR(LBound(myVARR, 1) + I, LBound(myVARR, 2) + L) = myX Then myXVal = 1
If myVARR(LBound(myVARR, 1) + I, LBound(myVARR, 2) + L) = myY Then myYVal = 1
Next L
If (myXVal * myYVal) > 0 Then
Sheets(ShCross).Cells(J, K).Value = Sheets(ShCross).Cells(J, K).Value + 1
End If
End If
Next I
Next K
Next J
End Sub
Personalizza le istruzioni marcate << e poi manda in esecuzione la macro; controlla il risultato su foglio impostato in "ShCross" (attenzione, prima della ri-compilazione l' area dati in "ShCross" sara' azzerata senza nessun preavviso, quindi...)
Ciao