ciao,
lieto di esserti stato utile
saluti
Moderatori: Anthony47, Flash30005
Private Sub Worksheet_Activate()
Dest = "E8"
Range(Dest).Offset(1, 0).Resize(100, 200).ClearContents
For I = 9 To 5000
If Foglio1.Cells(I, "W").Value = "f" Then
Foglio28.Range(Dest).Offset(CI + 1, CEffe - 0) = Foglio1.Cells(I, "P")
CEffe = CEffe + 1: CI = 0
Else
If Foglio1.Cells(I, "P") <> "" Then
Foglio28.Range(Dest).Offset(CI + 1, CEffe - 0) = Foglio1.Cells(I, "P")
CI = CI + 1
End If
End If
Next I
End Sub
Sub analizquote()
Sheets("2-Statistiche").Select
UserForm2.Show vbModeless
DoEvents
Inizio = Timer
ActiveSheet.Unprotect
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim I As Integer: Dim J As Integer: Dim R As Integer
Dim ContaVM(12) As Integer
Dim ContaPM(12) As Integer
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set Ws1 = Sheets("1-masa1-Fogl.Base")
Set Ws2 = Sheets("2-statistiche")
UR = Ws1.Range("I" & Rows.Count).End(xlUp).Row
UR2 = Ws2.Range("BA" & Rows.Count).End(xlUp).Row
Ws2.Range("BA9:BD" & UR2).ClearContents
For I = 9 To UR
If UCase(Ws1.Range("M" & I).Value) = "V" Then ContaVM(Month(Ws1.Range("C" & I).Value)) = ContaVM(Month(Ws1.Range("C" & I).Value)) + 1
If UCase(Ws1.Range("M" & I).Value) = "P" Then ContaPM(Month(Ws1.Range("C" & I).Value)) = ContaPM(Month(Ws1.Range("C" & I).Value)) + 1
UR2 = Ws2.Range("BA" & Rows.Count).End(xlUp).Row + 1
If UR2 < 9 Then UR2 = 9
For J = 9 To UR2
If Ws2.Cells(J, 53) = Ws1.Cells(I, 9) Then
Ws2.Cells(J, 54).Value = Ws2.Cells(J, 54).Value + 1
GoTo saltaI
Else
If Ws2.Cells(J, 53).Value = 0 Then
Ws2.Cells(J, 53) = Ws1.Cells(I, 9)
Ws2.Cells(J, 54).Value = 1
End If
End If
Next J
saltaI:
Next I
For CM = 1 To 12
Ws2.Range("DP" & CM + 8).Value = ContaVM(CM)
Ws2.Range("DQ" & CM + 8).Value = ContaPM(CM)
Next CM
UR2 = Ws2.Range("BA" & Rows.Count).End(xlUp).Row
For J = 9 To UR2
ContaV = 0
ContaP = 0
Q = Ws2.Range("BA" & J)
For I = 9 To UR
If Q = Ws1.Cells(I, 9) Then
If UCase(Ws1.Cells(I, 13)) = "V" Then ContaV = ContaV + 1
If UCase(Ws1.Cells(I, 13)) = "P" Then ContaP = ContaP + 1
End If
Next I
Ws2.Range("BC" & J) = ContaV
Ws2.Range("BD" & J) = ContaP
Next J
Sheets("2-statistiche").Select
Range("BA9:BD100").Select
Selection.Sort Key1:=Range("BA9"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ActiveWindow.ScrollRow = 1 ' alza la barra later dx
ActiveWindow.DisplayGridlines = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True
Range("BF2").Select
Unload UserForm2
Fine = Timer
MsgBox ("Tempo impiegato " & Int((Fine - Inizio) / 60) & " min " & (Fine - Inizio) Mod 60 & " Sec")
End Sub
Sub ContaContinuità()
ActiveSheet.Unprotect
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim I, Ris As Integer
Dim ContaVM(12) As Integer
Dim ContaPM(12) As Integer
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set Ws1 = Sheets("1-masa1-Fogl.Base")
Set Ws2 = Sheets("2-statistiche")
UR = Ws1.Range("I" & Rows.Count).End(xlUp).Row
For I = 9 To UR
If UCase(Ws1.Cells(I, 13)) = "V" Then
ContaV = ContaV + 1
Else
ContaVM(ContaV) = ContaVM(ContaV) + 1
ContaV = 0
End If
If UCase(Ws1.Cells(I, 13)) = "P" Then
ContaP = ContaP + 1
Else
ContaPM(ContaP) = ContaPM(ContaP) + 1
ContaP = 0
End If
Next I
For Ris = 1 To 12
Ws2.Range("DP" & Ris + 8).Value = ContaVM(Ris)
Ws2.Range("DQ" & Ris + 8).Value = ContaPM(Ris)
Next Ris
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub analizquote()
Sheets("2-Statistiche").Select
UserForm2.Show vbModeless
DoEvents
Inizio = Timer
ActiveSheet.Unprotect
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim I As Integer: Dim J As Integer: Dim R As Integer
Dim ContaVM(12) As Integer
Dim ContaPM(12) As Integer
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set Ws1 = Sheets("1-masa1-Fogl.Base")
Set Ws2 = Sheets("2-statistiche")
UR = Ws1.Range("I" & Rows.Count).End(xlUp).Row
UR2 = Ws2.Range("BA" & Rows.Count).End(xlUp).Row
Ws2.Range("BA9:BD" & UR2).ClearContents
For I = 9 To UR
If UCase(Ws1.Range("M" & I).Value) = "V" Then ContaVM(Month(Ws1.Range("C" & I).Value)) = ContaVM(Month(Ws1.Range("C" & I).Value)) + 1
If UCase(Ws1.Range("M" & I).Value) = "P" Then ContaPM(Month(Ws1.Range("C" & I).Value)) = ContaPM(Month(Ws1.Range("C" & I).Value)) + 1
UR2 = Ws2.Range("BA" & Rows.Count).End(xlUp).Row + 1
If UR2 < 9 Then UR2 = 9
For J = 9 To UR2
If Ws2.Cells(J, 53) = Ws1.Cells(I, 9) Then
Ws2.Cells(J, 54).Value = Ws2.Cells(J, 54).Value + 1
GoTo saltaI
Else
If Ws2.Cells(J, 53).Value = 0 Then
Ws2.Cells(J, 53) = Ws1.Cells(I, 9)
Ws2.Cells(J, 54).Value = 1
End If
End If
Next J
saltaI:
Next I
For CM = 1 To 12
Ws2.Range("DI" & CM + 8).Value = ContaVM(CM)
Ws2.Range("DJ" & CM + 8).Value = ContaPM(CM)
Next CM
UR2 = Ws2.Range("BA" & Rows.Count).End(xlUp).Row
For J = 9 To UR2
ContaV = 0
ContaP = 0
Q = Ws2.Range("BA" & J)
For I = 9 To UR
If Q = Ws1.Cells(I, 9) Then
If UCase(Ws1.Cells(I, 13)) = "V" Then ContaV = ContaV + 1
If UCase(Ws1.Cells(I, 13)) = "P" Then ContaP = ContaP + 1
End If
Next I
Ws2.Range("BC" & J) = ContaV
Ws2.Range("BD" & J) = ContaP
Next J
Ws2.Select
Range("BA9:BD100").Select
Selection.Sort Key1:=Range("BA9"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ActiveWindow.ScrollRow = 1 ' alza la barra later dx
ActiveWindow.DisplayGridlines = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True
Range("BF2").Select
Unload UserForm2
Fine = Timer
MsgBox ("Tempo impiegato " & Int((Fine - Inizio) / 60) & " min " & (Fine - Inizio) Mod 60 & " Sec")
End Sub
Torna a Applicazioni Office Windows
Copia dati dall' hard disk che conteneva il sistema operativ Autore: Olisa |
Forum: Software Windows Risposte: 2 |
Visitano il forum: Nessuno e 34 ospiti