Moderatori: Anthony47, Flash30005
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
Sheets(ShCross).Cells(2, 2).Resize(Rows.Count - 2, Columns.Count - 2).ClearContents
Sheets(ShCross).Range("B2:L1000").ClearContents
Sheets(ShCross).Cells(2, 14).Resize(Rows.Count - 2, Columns.Count - 15).ClearContents '**
LastR = Sheets(ShList).Range(TopRow).Range("A1").End(xlDown).Row
myVARR = Sheets(ShList).Range(TopRow).Resize(LastR).Value
For J = 14 To Sheets(ShCross).Range("N1").End(xlToRight).Column '**
For K = 2 To Sheets(ShCross).Range("M2").End(xlDown).Row '**
myX = Sheets(ShCross).Cells(1, J)
myY = Sheets(ShCross).Cells(K, 13) '**
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).Range("N2:BU61").ClearContents '**
LastR = Sheets(ShList).Range(TopRow).Range("A1").End(xlDown).Row
myVARR = Sheets(ShList).Range(TopRow).Resize(LastR).Value
For J = 14 To Sheets(ShCross).Range("N1").End(xlToRight).Column '**
For K = 2 To Sheets(ShCross).Range("M2").End(xlDown).Row '**
myX = Sheets(ShCross).Cells(1, J)
myY = Sheets(ShCross).Cells(K, 13) '**
For I = 0 To LastR - 1
myXVal = 0: myYVal = 0
If myX <> myY Then
For L = 0 To Worksheets(ShList).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(K, J).Value = Sheets(ShCross).Cells(K, J).Value + 1
End If
End If
Next I
Next K
Next J
End Sub
Sheets(ShCross).Cells(K, J).Value = Sheets(ShCross).Cells(K, J).Value + 1
Torna a Applicazioni Office Windows
Conteggio colonne indipendenti excel o powerbi Autore: Blu_ice |
Forum: Applicazioni Office Windows Risposte: 9 |
Conteggio date in giorni e contare le righe delle date Autore: ikwae |
Forum: Applicazioni Office Windows Risposte: 4 |
Foglio presenze in stile calendario perpetuo: bloccare una c Autore: BSara |
Forum: Applicazioni Office Windows Risposte: 7 |
distribuire le presenze in base a disponibilità Autore: wallace&gromit |
Forum: Applicazioni Office Windows Risposte: 5 |
Visitano il forum: Nessuno e 20 ospiti