Penso che Il file contenga dati sensibili e quindi non sarò io a pubblicarlo
comunque la cartella contiene due fogli "LOG" e "SUMMARY"
Il foglio LOG contiene tutti i dati alcuni digitati dagli utenti altri ottenuti con delle formule
I punti chiave si trovano nella colonna C e colonna AB
nella colonna C come ha spiegato Extrude ci possono essere 5 diverse condizioni da 07A a 07E (una per riga)
Nella colonna AB c'è un testo, più o meno su tutte le celle, di questo tipo
- Codice: Seleziona tutto
"(1st) COMMENTED #
(2nd) COMMENTED (MINOR) #
testo testo testo
....
"
oppure
- Codice: Seleziona tutto
"(1st) COMMENTED (MINOR) #
testo testo testo
(2nd) APPROVED #
(testo testo testo) '<<<<<<non sempre
Il foglio SUMMARY è il foglio che deve essere compilato e presenta 8 tabelle
trascurando la prima e le ultime due per riferirsi principalmente alle colonne sopra elencate (C e AB)
si dovevano dividere e quindi conteggiare gli:
"Approved" '<<<< (di due tipi)
"Commented (Minor)"
"Commented"
"Commented (Rejected)"
Considerando che gli Approved potevano essere senza commenti o con commenti e suddividendo ogni gruppo
per 1st, 2nd e 3rd e inoltre ognuno di questi per i 5 sottogruppi 07A a 07E.
in pratica per ottenere qualcosa come questa immagine
La macro è attivata ogni qualvolta che si attiva il foglio Summary e impiega 1 secondo circa
- Codice: Seleziona tutto
Sub CompilaSchede()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Worksheets("SUMMARY").Range("E4:E142").ClearContents
URL = Worksheets("LOG").Cells(Rows.Count, 3).End(xlUp).Row
Dim VettS(10) As String
'Dim VettB(10) As Integer
ContaA = 0
ContaB = 0
ContaC = 0
ContaD = 0
ContaE = 0
ContaF = 0
For RR = 4 To URL
StrL = Worksheets("LOG").Range("AB" & RR).Text
LStrL = Len(StrL)
LettC = Mid(Trim(Worksheets("LOG").Range("C" & RR).Text), 3, 1)
Select Case LettC
Case "A"
RigaC = 0
Case "B"
RigaC = 1
Case "C"
RigaC = 2
Case "D"
RigaC = 3
Case "E"
RigaC = 4
End Select
CaL = 0
For Car = 1 To LStrL
If Mid(StrL, Car, 1) = "#" Then
CaL = CaL + 1
VettS(CaL) = Trim(Mid(StrL, (Car - 9), 8))
Select Case VettS(CaL)
Case "APPROVED"
VarRS = Val(Mid(StrL, Car - 14, 1))
VerifApp = Mid(StrL, Car, 10)
If VerifApp = "#" Then
VarG = 12
Else
VarG = 31
End If
Case "(MINOR)"
VarRS = Val(Mid(StrL, Car - 23, 1))
VarG = 50
Case "OMMENTED"
VarRS = Val(Mid(StrL, Car - 15, 1))
VarG = 69
Case "EJECTED)"
VarRS = Val(Mid(StrL, Car - 26, 1))
VarG = 88
Case Else
GoTo salta
End Select
VarR = (VarRS - 1) * 6
riga = VarG + VarR + RigaC
Worksheets("SUMMARY").Range("E" & riga).Value = Worksheets("SUMMARY").Range("E" & riga).Value + 1
End If
salta:
Next Car
For Col = 22 To 24
If Trim(Worksheets("LOG").Cells(RR, Col).Text) = "WAITING" Or Trim(Worksheets("LOG").Cells(RR, Col).Text) = "TO ASK" Or Trim(Worksheets("LOG").Cells(RR, Col).Text) = "SPEED-UP" Or Trim(Worksheets("LOG").Cells(RR, Col).Text) = "OVER ONE MONTH???" Then
Worksheets("SUMMARY").Range("E" & 107 + (Col - 22) * 6 + RigaC).Value = Worksheets("SUMMARY").Range("E" & 107 + (Col - 22) * 6 + RigaC).Value + 1
End If
If Trim(Worksheets("LOG").Cells(RR, Col).Text) = "WAITING AS BUILT" Then
If Col = 22 Then
Worksheets("SUMMARY").Range("E" & 126 + (Col - 22) * 6 + RigaC).Value = Worksheets("SUMMARY").Range("E" & 126 + (Col - 22) * 6 + RigaC).Value + 1
Else
Worksheets("SUMMARY").Range("F" & 126 + (Col - 22) * 6 + RigaC).Value = Worksheets("SUMMARY").Range("F" & 126 + (Col - 22) * 6 + RigaC).Value + 1
End If
End If
Next Col
If Mid(Trim(Worksheets("LOG").Range("AC" & RR).Value), 1, 3) = "YES" Then ContaA = ContaA + 1
If Mid(Trim(Worksheets("LOG").Range("AC" & RR).Value), 1, 2) = "NO" Then ContaB = ContaB + 1
If Trim(Worksheets("LOG").Range("S" & RR).Text) = "" Then ContaC = ContaC + 1
If Trim(Worksheets("LOG").Range("T" & RR).Text) = "" Then ContaD = ContaD + 1
If Trim(Worksheets("LOG").Range("U" & RR).Text) = "" Then ContaE = ContaE + 1
If Trim(Worksheets("LOG").Range("Y" & RR).Text) = "" Then ContaF = ContaF + 1
Next RR
Sheets("SUMMARY").Select
Range("F131, F137").FormulaR1C1 = "=SUM(R[1]C:R[5]C)"
For RF = 131 To 142
If RF <= 136 Then
Range("E" & RF).Value = Range("F" & RF).Value - Range("E" & RF - 6).Value
Else
Range("E" & RF).Value = Range("F" & RF).Value - Range("F" & RF - 6).Value
End If
Next RF
Range("E11,E17,E23,E30, E36, E42, E49, E55, E61, E68, E74, E80, E87, E93, E99, E106, E112, E118, E125, E131, E137").FormulaR1C1 = "=SUM(R[1]C:R[5]C)"
Worksheets("SUMMARY").Range("E4").Value = ContaA
Worksheets("SUMMARY").Range("E5").Value = ContaB
Worksheets("SUMMARY").Range("E6").Value = URL - ContaC - 3
Worksheets("SUMMARY").Range("E7").Value = URL - ContaD - 3
Worksheets("SUMMARY").Range("E8").Value = URL - ContaE - 3
Worksheets("SUMMARY").Range("E9").Value = URL - ContaF - 3
Worksheets("SUMMARY").Range("F124:F142").ClearContents
URS = Worksheets("SUMMARY").Cells(Rows.Count, 3).End(xlUp).Row
For RR = 10 To URS
If RR = 10 Then GoTo saltaN
PP = (RR - 10) Mod 19
If PP <> 0 Then If Range("E" & RR).Value = 0 Then Range("E" & RR).Value = 0
saltaN:
Next RR
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Capisco che senza un foglio dati tutto questo codice serva a poco ma non posso pubblicare documentazione altrui.
Ciao