procediamo per passi
controlla che lo storico vada bene
che la riga 305 cumulatrice di ritardi sia estratto che resto sia corretta
per il resto riga 312 scrivi i valori che vorresti avere e i colori
e rinvia il file
http://www.filedropper.com/copia2
Moderatori: Anthony47, Flash30005
Sub ColATQC_E_Storico()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = 302
Col = 18
Passo = 68
PassoSt = 23
ColI = 59
ColF = ColI + 54
Worksheets("Foglio1").Select
Range("BG305:DJ305").ClearContents
For Ciclo = 1 To 1
Range(Cells(3, ColI + (Ciclo - 1) * Passo), Cells(UR, ColF + (Ciclo - 1) * Passo)).Interior.ColorIndex = xlNone
SR = 0
FoB = 2
riga = UR + 13
Col = Col + Passo
For CC = 59 + (Ciclo - 1) * Passo To 113 + (Ciclo - 1) * Passo Step 5
FoB = FoB + 2
SR = SR + 1
CCS = 1 + PassoSt * (Ciclo - 1) + (SR - 1) * 2
CCS2 = 1 + PassoSt * (Ciclo) + (SR - 1) * 2
riga = riga + 1
Estratto = 0
Ambi = 0
Terni = 0
Quaterne = 0
Cinquine = 0
For RR = 3 To UR
EV = 0
ContaA = 0
For CCR = CC + 0 To CC + 4
If Val(Cells(RR, CCR)) > 0 Then
ContaA = ContaA + 1
If ContaA > 1 Then EV = 2
If ContaA = 1 Then EV = 1
End If
Next CCR
CI = xlNone
Select Case ContaA
Case 1
Estratto = Estratto + 1
Cells(305, CC + 2).Value = UR - RR
Cells(314, FoB).Value = UR - RR
Case 2
Ambi = Ambi + 1
CI = 15
Cells(305, CC + 2).Value = UR - RR
Cells(312, FoB).Value = UR - RR
Case 3
Terni = Terni + 1
CI = 4
Cells(305, CC + 2).Value = UR - RR
Cells(312, FoB).Value = UR - RR
Case 4
Quaterne = Quaterne + 1
CI = 33
Cells(305, CC + 2).Value = UR - RR
Cells(312, FoB).Value = UR - RR
Case 5
Cinquine = Cinquine + 1
CI = 45
Cells(305, CC + 2).Value = UR - RR
Cells(312, FoB).Value = UR - RR
Case Else
CI = xlNone
End Select
Range(Cells(RR, CC), Cells(RR, CC + 4)).Interior.ColorIndex = CI
If EV > 0 Then
Conc = Cells(RR, 1)
URS2 = Worksheets("Storici").Cells(Rows.Count, CCS2).End(xlUp).Row
ConcSt2 = Worksheets("Storici").Cells(URS2, CCS2).Value
If Conc > ConcSt2 Then
Worksheets("Storici").Cells(URS2 + 1, CCS2).Value = Conc
Worksheets("Storici").Cells(URS2 + 1, CCS2 + 1).Value = Conc - ConcSt2
End If
If EV = 2 Then
URS = Worksheets("Storici").Cells(Rows.Count, CCS).End(xlUp).Row
ConcSt = Worksheets("Storici").Cells(URS, CCS).Value
If Conc > ConcSt Then
Worksheets("Storici").Cells(URS + 1, CCS).Value = Conc
Worksheets("Storici").Cells(URS + 1, CCS + 1).Value = Conc - ConcSt
End If
End If
End If
Next RR
Cells(riga, Col).Value = Estratto
Cells(riga, Col + 1).Value = Ambi
Cells(riga, Col + 2).Value = Terni
Cells(riga, Col + 3).Value = Quaterne
Cells(riga, Col + 4).Value = Cinquine
Next CC
Next Ciclo
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
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 79 ospiti