Moderatori: Anthony47, Flash30005
=SOMMA(SE((Storici!$B$8:$B$65000=C$1)*(Storici!$C$8:$C$65000=$A3);1;0))
Sub tuamacro()
Application.ScreenUpdating = False
Application.Calculation = xlManual
'...
'... linee codice macro
'...
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Tuamacro()
Application.EnableEvents = False
'.... codice macro
'....
Application.EnableEvents = True
End Sub
Public UgB7, UgD7 As String, Col As Integer
Sub B7D7()
UgB7 = "="
UgD7 = "="
Columns("G:G").Clear
Col = 7
ColoraSe3
End Sub
Sub B7U()
UgB7 = "="
UgD7 = "."
Columns("I:I").Clear
Col = 9
ColoraSe3
End Sub
Sub D7U()
UgB7 = "."
UgD7 = "="
Columns("K:K").Clear
Col = 11
ColoraSe3
End Sub
Sub DivB7D7()
UgB7 = "."
UgD7 = "."
Columns("M:M").Clear
Col = 13
ColoraSe3
End Sub
Sub ColoraSe3()
Worksheets("Storici").Select
----------------------------------------------------------------------
Questa è l'ultima dove è stato inserito un nuovo modulo e, visualizza i gruppi in colonna "G".
Public UgB7, UgE7 As String, Col As Integer
Sub B7E7()
UgB7 = "="
UgE7 = "="
Col = 7
ColoraSe3
End Sub
Sub ColoraSe3()
Worksheets("Storici").Select
UR = Range("A" & Rows.Count).End(xlUp).Row
Columns("A:F").Interior.ColorIndex = xlNone
Columns("A:F").Font.ColorIndex = 0
Columns(Col).Clear
For RR = 8 To UR - 1
RF = RR
RI = RR
AC = 0
AggCol = Range("B" & RR).Value
Str1 = Range("A" & RR).Value & Range("E" & RR).Value & Range("F" & RR).Value
Conta = 1
For RR2 = RR + 1 To UR
Str2 = Range("A" & RR2).Value & Range("E" & RR2).Value & Range("F" & RR2).Value
If Str1 <> Str2 Then GoTo SaltaRR
If UgB7 = "=" Then
If Range("B" & RR).Value <> Range("B" & RR2).Value Then GoTo SaltaRR
Else
If Range("B" & RR).Value = Range("B" & RR2).Value Then GoTo SaltaRR
End If
If UgE7 = "=" Then
If Range("E" & RR).Value <> Range("E" & RR2).Value Then GoTo SaltaRR
Else
If Range("E" & RR).Value = Range("E" & RR2).Value Then GoTo SaltaRR
End If
RF = RR2
RR = RR2
Conta = Conta + 1
Next RR2
SaltaRR:
Select Case AggCol
Case "Ba"
AC = 0
Case "Ca"
AC = 9
Case "Fi"
AC = 10
Case "Ge"
AC = 11
Case "Mi"
AC = 12
Case "Na"
AC = 13
Case "Pa"
AC = 14
Case "Ro"
AC = 15
Case "To"
AC = 16
Case "Ve"
AC = 17
End Select
ColR = xlNone
Select Case Conta
Case 2
ColR = 6
Case 3
ColR = 43
Case 4
ColR = 48
Case 5
ColR = 33
End Select
If ColR <> xlNone Then
ColR = (ColR + AC) Mod 49
If ColR = 0 Or ColR = 1 Then ColR = ColR + 10
End If
Range("A" & RI & ":F" & RF).Interior.ColorIndex = ColR
If Conta > 1 Then
Range(Cells(RI, Col), Cells(RF, Col)).Value = Conta
Range(Cells(RI + 1, Col), Cells(RF, Col)).Font.ColorIndex = 2
End If
If ColR = 11 Or ColR = 9 Or ColR = 13 Or ColR = 5 Or ColR = 21 Then
Range("A" & RI & ":F" & RF).Font.ColorIndex = 2
End If
RR = RF
Next RR
End Sub
UR = Range("A" & Rows.Count).End(xlUp).Row
Columns("A:F").Interior.ColorIndex = xlNone
Columns("A:F").Font.ColorIndex = 0
For RR = 8 To UR - 1
RF = RR
RI = RR
AC = 0
AggCol = Range("B" & RR).Value
Str1 = Range("A" & RR).Value & Range("E" & RR).Value & Range("F" & RR).Value
Conta = 1
For RR2 = RR + 1 To UR
Str2 = Range("A" & RR2).Value & Range("E" & RR2).Value & Range("F" & RR2).Value
If Str1 <> Str2 Then GoTo SaltaRR
If UgB7 = "=" Then
If Range("B" & RR).Value <> Range("B" & RR2).Value Then GoTo SaltaRR
Else
If Range("B" & RR).Value = Range("B" & RR2).Value Then GoTo SaltaRR
End If
If UgD7 = "=" Then
If Range("D" & RR).Value <> Range("D" & RR2).Value Then GoTo SaltaRR
Else
If Range("D" & RR).Value = Range("D" & RR2).Value Then GoTo SaltaRR
End If
RF = RR2
RR = RR2
Conta = Conta + 1
Next RR2
SaltaRR:
Select Case AggCol
Case "Ba"
AC = 0
Case "Ca"
AC = 9
Case "Fi"
AC = 10
Case "Ge"
AC = 11
Case "Mi"
AC = 12
Case "Na"
AC = 13
Case "Pa"
AC = 14
Case "Ro"
AC = 15
Case "To"
AC = 16
Case "Ve"
AC = 17
End Select
ColR = xlNone
Select Case Conta
Case 2
ColR = 6
Case 3
ColR = 43
Case 4
ColR = 48
Case 5
ColR = 33
End Select
If ColR <> xlNone Then
ColR = (ColR + AC) Mod 49
If ColR = 0 Or ColR = 1 Then ColR = ColR + 10
End If
Range("A" & RI & ":F" & RF).Interior.ColorIndex = ColR
If Conta > 1 Then
Range(Cells(RI, Col), Cells(RF, Col)).Value = Conta
'Range("G" & RI & ":G" & RF).Value = Conta
Range(Cells(RI + 1, Col), Cells(RF, Col)).Font.ColorIndex = 2
'Range("G" & RI + 1 & ":G" & RF).Font.ColorIndex = 2
End If
If ColR = 11 Or ColR = 9 Or ColR = 13 Or ColR = 5 Or ColR = 21 Then
Range("A" & RI & ":F" & RF).Font.ColorIndex = 2
End If
RR = RF
Next RR
End Sub
Public UgB7, UgE7, UgD7 As String, Col As Integer
Sub B7E7()
UgB7 = "="
UgE7 = "="
Col = 7
ColoraSeE
End Sub
Sub ColoraSeE()
Worksheets("Attuali").Select
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Range("A" & Rows.Count).End(xlUp).Row
Columns("A:F").Interior.ColorIndex = xlNone
Columns("A:F").Font.ColorIndex = 0
Columns(Col).Clear
For RR = 13 To UR - 1
RF = RR
RI = RR
AC = 0
AggCol = Range("B" & RR).Value
Str1 = Range("A" & RR).Value & Range("E" & RR).Value & Range("F" & RR).Value
Conta = 1
For RR2 = RR + 1 To UR
Str2 = Range("A" & RR2).Value & Range("E" & RR2).Value & Range("F" & RR2).Value
If Str1 <> Str2 Then GoTo SaltaRR
If UgB7 = "=" Then
If Range("B" & RR).Value <> Range("B" & RR2).Value Then GoTo SaltaRR
Else
If Range("B" & RR).Value = Range("B" & RR2).Value Then GoTo SaltaRR
End If
If UgE7 = "=" Then
If Range("E" & RR).Value <> Range("E" & RR2).Value Then GoTo SaltaRR
Else
If Range("E" & RR).Value = Range("E" & RR2).Value Then GoTo SaltaRR
End If
RF = RR2
RR = RR2
Conta = Conta + 1
Next RR2
SaltaRR:
Select Case AggCol
Case "Ba"
AC = 0
Case "Ca"
AC = 9
Case "Fi"
AC = 10
Case "Ge"
AC = 11
Case "Mi"
AC = 12
Case "Na"
AC = 13
Case "Pa"
AC = 14
Case "Ro"
AC = 15
Case "To"
AC = 16
Case "Ve"
AC = 17
End Select
ColR = xlNone
Select Case Conta
Case 2
ColR = 6
Case 3
ColR = 43
Case 4
ColR = 48
Case 5
ColR = 33
End Select
If ColR <> xlNone Then
ColR = (ColR + AC) Mod 49
If ColR = 0 Or ColR = 1 Then ColR = ColR + 10
End If
Range("A" & RI & ":F" & RF).Interior.ColorIndex = ColR
If Conta > 1 Then
Range(Cells(RI, Col), Cells(RF, Col)).Value = Conta
Range(Cells(RI + 1, Col), Cells(RF, Col)).Font.ColorIndex = 2
End If
If ColR = 11 Or ColR = 9 Or ColR = 13 Or ColR = 5 Or ColR = 21 Then
Range("A" & RI & ":F" & RF).Font.ColorIndex = 2
End If
RR = RF
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub ColoraSe3()
Worksheets("Attuali").Select
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Range("A" & Rows.Count).End(xlUp).Row
Columns("A:F").Interior.ColorIndex = xlNone
Columns("A:F").Font.ColorIndex = 0
Columns(Col).Clear
For RR = 13 To UR - 1
RF = RR
RI = RR
AC = 0
AggCol = Range("B" & RR).Value
Str1 = Range("A" & RR).Value & Range("E" & RR).Value & Range("F" & RR).Value
Conta = 1
For RR2 = RR + 1 To UR
Str2 = Range("A" & RR2).Value & Range("E" & RR2).Value & Range("F" & RR2).Value
If Str1 <> Str2 Then GoTo SaltaRR
If UgB7 = "=" Then
If Range("B" & RR).Value <> Range("B" & RR2).Value Then GoTo SaltaRR
Else
If Range("B" & RR).Value = Range("B" & RR2).Value Then GoTo SaltaRR
End If
If UgD7 = "=" Then
If Range("D" & RR).Value <> Range("D" & RR2).Value Then GoTo SaltaRR
Else
If Range("D" & RR).Value = Range("D" & RR2).Value Then GoTo SaltaRR
End If
RF = RR2
RR = RR2
Conta = Conta + 1
Next RR2
SaltaRR:
Select Case AggCol
Case "Ba"
AC = 0
Case "Ca"
AC = 9
Case "Fi"
AC = 10
Case "Ge"
AC = 11
Case "Mi"
AC = 12
Case "Na"
AC = 13
Case "Pa"
AC = 14
Case "Ro"
AC = 15
Case "To"
AC = 16
Case "Ve"
AC = 17
End Select
ColR = xlNone
Select Case Conta
Case 2
ColR = 6
Case 3
ColR = 43
Case 4
ColR = 48
Case 5
ColR = 33
End Select
If ColR <> xlNone Then
ColR = (ColR + AC) Mod 49
If ColR = 0 Or ColR = 1 Then ColR = ColR + 10
End If
Range("A" & RI & ":F" & RF).Interior.ColorIndex = ColR
If Conta > 1 Then
Range(Cells(RI, Col), Cells(RF, Col)).Value = Conta
Range(Cells(RI + 1, Col), Cells(RF, Col)).Font.ColorIndex = 2
End If
If ColR = 11 Or ColR = 9 Or ColR = 13 Or ColR = 5 Or ColR = 21 Then
Range("A" & RI & ":F" & RF).Font.ColorIndex = 2
End If
RR = RF
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Flash30005 ha scritto:Ho preso in considerazione il foglio "Statistica2"
in C3 inserisci questa formula
- Codice: Seleziona tutto
=SOMMA(SE((Storici!$B$8:$B$65000=C$1)*(Storici!$C$8:$C$65000=$A3);1;0))
Per confermare premi Ctrl+Shift+Enter
poi trascini verso destra per copiare fino alla colonna L (Venezia)
Selezioni l'intera riga e la copi verso il basso fino dove serve
ma... sono milioni di formule....
ciao
=MAX(SE(Storici!$B$8:$B$25000=C$1;SE(Storici!$C$8:$C$25000=$A6;Storici!$E$8:$E$25000;)))
Lucio Peruggini ha scritto:Scusami ma devo approfittare della tua competenza; come suol dirsi, " l'appetito vien mangiando". Ci avevo già pensato prima ma credevo fosse troppo complicato e non volevo renderti la vita difficile. Noto con piacere, però, che non avete limiti quando capite bene il quesito!
Allego il medesimo file modificato dove ho aggiunto delle colonne per la 1°, 2°, 3°, 4°, 5° posizione. Per ognuna d'esse ci sono due colonne; una per gli eventi singoli di posizione, l'altra per il ritardo Max degli eventi medesimi.
Esempio sulla ruota di Bari:
N. 1 eventi totali delle cinque posiz. 30 con Rit. Max 346 di cui:
1° pos. 6 rit. 108
2° pos. 6 rit. 64
3° pos. 6 rit. 346
4° pos. 6 rit. 312
5° pos. 6 rit. 154
allego file
http://sharesend.com/dw8ii
Ciao
Torna a Applicazioni Office Windows
Modidica Formula Somma I Riferimenti Autore: Francesco6918 |
Forum: Applicazioni Office Windows Risposte: 2 |
Excel: formula automatica per evidenziare prodotto scaduto Autore: gamma_ray |
Forum: Applicazioni Office Windows Risposte: 3 |
Salvare file excel in formato html escludendo le immagini Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 10 |
formula excel non visualizza risultato Autore: tommasog |
Forum: Applicazioni Office Windows Risposte: 6 |
Excel 2016 - Funzione SCARTO + INDIRETTO Autore: pl1957 |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 82 ospiti