Moderatori: Anthony47, Flash30005
Sub ColoraEContaRitDef()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UC = Worksheets("Archivio_con_Macro").Range("IV1").End(xlToLeft).Column
URD = Worksheets("Archivio_con_Macro").Range("C" & Rows.Count).End(xlUp).Row
Worksheets("Archivio_con_Macro").Range("C1:G" & URD).Interior.ColorIndex = xlNone
Worksheets("Archivio_con_Macro").Columns("I:I").ClearContents
Area = "C2:G" & URD
Ruota = ""
ValRes = Worksheets("Archivio_con_Macro").Range("E1").Value
For Each Valca In Worksheets("Archivio_con_Macro").Range(Area)
If ValRes = Valca Then
Valca.Interior.ColorIndex = 44
End If
Next
For RR = 2 To URD
Ruota = Worksheets("Archivio_con_Macro").Range("B" & RR).Value
If MRuota <> Ruota Then
ContaR = 0
MRuota = Ruota
Else
MyC = Evaluate("=SUM(COUNTIF(Archivio_con_Macro!C" & RR & ":G" & RR & ",Archivio_con_Macro!L1:N1))")
MyRes = Evaluate("=SUM(COUNTIF(Archivio_con_Macro!C" & RR & ":G" & RR & ",Archivio_con_Macro!E1:E1))")
If MyRes = 1 Then
ContaR = 0
TrRes = 1
Else
If MyC > 0 And TrRes = 1 Then
Worksheets("Archivio_con_Macro").Range("I" & RR).Value = ContaR
ContaR = 0
TrRes = 0
For CC1 = 3 To 7
ValT = Worksheets("Archivio_con_Macro").Cells(RR, CC1).Value
If ValT = [L1] Or ValT = [M1] Or ValT = [N1] Then Worksheets("Archivio_con_Macro").Cells(RR, CC1).Interior.ColorIndex = 6
Next CC1
End If
End If
End If
ContaR = ContaR + 1
Next RR
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Area = "C2:G" & URD
ValRes = Worksheets("Archivio_con_Macro").Range("E1").Value
For Each Valca In Worksheets("Archivio_con_Macro").Range(Area)
If ValRes = Valca Then
Valca.Interior.ColorIndex = 44
End If
Next
Anthony47 ha scritto:Scusa, non so se e' l' orticaria per l' argomento o se effettivamente ci sono un paio di errori:
-con "L1; 2; 3; ecc." intendi L1, L2, L3 etc oppure L1, M1, N1 etc??
-per "colonna A7" intendi per caso cella E7?
Poi, perche' non hai segnato il ritardo del 60 presente in G18 (dovrebbe essere 7?) e del 90 presente in D19 (dovrebbe essere 0?). Analoga domanda per il 60 in E32, E44 e altre posizioni.
Ciao
...
If MRuota <> Ruota Then '<<< condizione esistente
ContaR = 0 '<<< esistente
TrRes = 0 '<<<<<<<<<<<<<<< aggiungere
MRuota = Ruota '<<< esistente
Else '<<< esistente
....
Sub ColoraEContaRitDef()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UC = Worksheets("Archivio_con_Macro").Range("IV1").End(xlToLeft).Column
URD = Worksheets("Archivio_con_Macro").Range("C" & Rows.Count).End(xlUp).Row
Worksheets("Archivio_con_Macro").Range("C1:G" & URD).Interior.ColorIndex = xlNone
Worksheets("Archivio_con_Macro").Columns("I:J").ClearContents
Area = "C2:G" & URD
Ruota = ""
ValRes = Worksheets("Archivio_con_Macro").Range("E1").Value
For Each Valca In Worksheets("Archivio_con_Macro").Range(Area)
If ValRes = Valca Then
Valca.Interior.ColorIndex = 44
End If
Next
For RR = 2 To URD
Ruota = Worksheets("Archivio_con_Macro").Range("B" & RR).Value
If MRuota <> Ruota Then
ContaRI = 0
ContaR = 0
TrRes = 0
MRuota = Ruota
Else
MyC = Evaluate("=SUM(COUNTIF(Archivio_con_Macro!C" & RR & ":G" & RR & ",Archivio_con_Macro!L1:N1))")
MyRes = Evaluate("=SUM(COUNTIF(Archivio_con_Macro!C" & RR & ":G" & RR & ",Archivio_con_Macro!E1:E1))")
If MyRes = 1 Then
ContaR = 0
TrRes = 1
Else
If MyC > 0 And TrRes = 1 Then
Worksheets("Archivio_con_Macro").Range("I" & RR).Value = ContaR
If ContaR <> ContaRI Then Worksheets("Archivio_con_Macro").Range("J" & RR).Value = ContaRI
ContaR = 0
ContaRI = 0
TrRes = 0
For CC1 = 3 To 7
ValT = Worksheets("Archivio_con_Macro").Cells(RR, CC1).Value
If ValT = [L1] Or ValT = [M1] Or ValT = [N1] Then Worksheets("Archivio_con_Macro").Cells(RR, CC1).Interior.ColorIndex = 6
Next CC1
End If
End If
End If
ContaR = ContaR + 1
If TrRes = 1 Then ContaRI = ContaRI + 1
Next RR
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
If TrRes = 1 Then ContaRI = ContaRI + 1
ContaRI = ContaRI + 1
If MyC > 0 And TrRes = 1 Then '<<<<<<<<<<<<<<< esistente
Worksheets("Archivio_con_Macro").Range("I" & RR).Value = ContaR '<<<<<<<<<<< esistente
If ContaR <> ContaRI Then Worksheets("Archivio_con_Macro").Range("J" & RR).Value = ContaRI '<<< da modificare
Worksheets("Archivio_con_Macro").Range("J" & RR).Value = ContaRI
Ba;Ca;Fi;Ge;Mi;Na;Pa;Ro;To;Ve;TT
Sub ColoraEContaRitDef()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UC = Worksheets("Archivio_con_Macro").Range("IV1").End(xlToLeft).Column
URD = Worksheets("Archivio_con_Macro").Range("C" & Rows.Count).End(xlUp).Row
Worksheets("Archivio_con_Macro").Range("C1:G" & URD).Interior.ColorIndex = xlNone
Worksheets("Archivio_con_Macro").Range("L1:N1").Interior.ColorIndex = 6
Worksheets("Archivio_con_Macro").Columns("I:J").ClearContents
Area = "C1:G" & URD
Ruota = ""
RuotaDef = Worksheets("Archivio_con_Macro").Range("F1").Value
ValRes = Worksheets("Archivio_con_Macro").Range("E1").Value
For Each Valca In Worksheets("Archivio_con_Macro").Range(Area)
If ValRes = Valca Then
Valca.Interior.ColorIndex = 44
End If
Next
For RR = 2 To URD
Ruota = Worksheets("Archivio_con_Macro").Range("B" & RR).Value
If RuotaDef <> "TT" Then
If Ruota <> RuotaDef Then GoTo SaltaRR
End If
If MRuota <> Ruota Then
ContaRI = 0
ContaR = 0
TrRes = 0
MRuota = Ruota
Else
MyC = Evaluate("=SUM(COUNTIF(Archivio_con_Macro!C" & RR & ":G" & RR & ",Archivio_con_Macro!L1:N1))")
MyRes = Evaluate("=SUM(COUNTIF(Archivio_con_Macro!C" & RR & ":G" & RR & ",Archivio_con_Macro!E1:E1))")
If MyRes = 1 Then
ContaR = 0
TrRes = 1
Else
If MyC > 0 And TrRes = 1 Then
Worksheets("Archivio_con_Macro").Range("I" & RR).Value = ContaR
Worksheets("Archivio_con_Macro").Range("J" & RR).Value = ContaRI
ContaR = 0
ContaRI = 0
TrRes = 0
For CC1 = 3 To 7
ValT = Worksheets("Archivio_con_Macro").Cells(RR, CC1).Value
If ValT = [L1] Or ValT = [M1] Or ValT = [N1] Then Worksheets("Archivio_con_Macro").Cells(RR, CC1).Interior.ColorIndex = 6
Next CC1
End If
End If
End If
ContaR = ContaR + 1
If TrRes = 1 Then ContaRI = ContaRI + 1
SaltaRR:
Next RR
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Torna a Applicazioni Office Windows
Macro che scatta quando cambia dato in un altro file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 14 |
Problema con macro copia e rinomina file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
Macro che ricerca combinazioni che danno un valore Autore: kar64 |
Forum: Applicazioni Office Windows Risposte: 10 |
Macro che indica la riga prima della cella attiva Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 19 |
Visitano il forum: Nessuno e 59 ospiti