Ecco un anteprima del programma,come vedi a sinistra ho messo delle celle di controllo delle
ultime estrazioni del mese in corso.
Moderatori: Anthony47, Flash30005
=SE(MESE(C9)=MESE(C10);"";MAX($B$3:$B8)+1)
Sub TrovaEstr()
UR = Worksheets("Archivio").Range("A" & Rows.Count).End(xlUp).Row + 1
If UR < 3 Then UR = 3
Range("B3:B" & UR).ClearContents
MM = Month(Range("C3").Value)
CS = 0
Application.EnableEvents = False
ES = Range("J2").Value
For RR = 3 To UR
'If Len(Range("C" & RR).Value) > 9 Then
If Month(Range("C" & RR).Value) <> MM Then
If ES <> "FM" Then
For RS = 1 To ES
If ES = RS Then
CS = CS + 1
If Range("C" & RR).Value <> "" Then Range("B" & RR).Value = CS
RR = RR - 1
End If
RR = RR + 1
Next RS
MM = Month(Range("C" & RR).Value)
Else
CS = CS + 1
'RigaP = RR
If MM <> "" Then Range("B" & RigaP).Value = CS
End If
Else
RigaP = RR
End If
MM = Month(Range("C" & RR).Value)
'End If
Next RR
Application.EnableEvents = True
End Sub
Public GS
Sub TrovaEstr()
AggV = 0
If Range("J2").Value = "FM" Then AggV = 1
UR = Worksheets("Archivio").Range("A" & Rows.Count).End(xlUp).Row + AggV
If UR < 3 Then UR = 3
Range("B3:B" & UR).ClearContents
MM = Month(Range("C3").Value)
CS = 0
Application.EnableEvents = False
ES = Range("J2").Value
For RR = 3 To UR
'If Len(Range("C" & RR).Value) > 9 Then
If Month(Range("C" & RR).Value) <> MM Then
If ES <> "FM" Then
For RS = 1 To ES
If ES = RS Then
CS = CS + 1
If Range("C" & RR).Value <> "" Then Range("B" & RR).Value = CS
RR = RR - 1
End If
RR = RR + 1
Next RS
MM = Month(Range("C" & RR).Value)
Else
CS = CS + 1
If MM <> "" Then Range("B" & RigaP).Value = CS
End If
Else
RigaP = RR
End If
MM = Month(Range("C" & RR).Value)
'End If
Next RR
If Range("J2").Value = "FM" Then
ControllaFM
End If
Application.EnableEvents = True
End Sub
Sub ControllaFM()
UR = Worksheets("Archivio").Range("A" & Rows.Count).End(xlUp).Row
For GG = 1 To 31
DataG = GG & "/" & Month(Range("C" & UR).Value) & "/" & Year(Range("C" & UR).Value)
On Error GoTo EsciD
If Weekday(DataG, 2) = 2 Or Weekday(DataG, 2) = 4 Or Weekday(DataG, 2) = 6 Then
GS = Weekday(DataG, 2)
DataFM = DataG
End If
Next GG
EsciD:
On Error GoTo 0
If Range("C" & UR).Value <> DataFM And Weekday(Range("C" & UR).Value, 2) <> GS Then Range("B" & UR).ClearContents
'MsgBox DataFM & " " & GS
End Sub
Public CS
Sub TrovaEstr()
UR = Worksheets("Archivio").Range("A" & Rows.Count).End(xlUp).Row
If UR < 3 Then UR = 3
Range("B3:B" & UR).ClearContents
MM = Month(Range("C3").Value)
CS = 0
Application.EnableEvents = False
ES = Range("J2").Value
For RR = 3 To UR
If Month(Range("C" & RR).Value) <> MM Then
If ES <> "FM" Then
For RS = 1 To ES
If ES = RS Then
CS = CS + 1
If Range("C" & RR).Value <> "" Then Range("B" & RR).Value = CS
RR = RR - 1
End If
RR = RR + 1
Next RS
MM = Month(Range("C" & RR).Value)
Else
CS = CS + 1
Range("B" & RigaP).Value = CS
End If
Else
RigaP = RR
End If
MM = Month(Range("C" & RR).Value)
Next RR
If Range("J2").Value = "FM" Then
ControllaFM
End If
Application.EnableEvents = True
End Sub
Sub ControllaFM()
UR = Worksheets("Archivio").Range("A" & Rows.Count).End(xlUp).Row
For GG = 1 To 31
DataG = Format(GG & "/" & Month(Range("C" & UR).Value) & "/" & Year(Range("C" & UR).Value), "dd/mm/yyyy")
On Error GoTo EsciD
If Weekday(DataG, 2) = 2 Or Weekday(DataG, 2) = 4 Or Weekday(DataG, 2) = 6 Then DataFM = DataG
Next GG
EsciD:
On Error GoTo 0
If Range("C" & UR).Value = DataFM Then Range("B" & UR).Value = CS + 1
End Sub
Torna a Applicazioni Office Windows
Automatizzare numero settimane nel mese di un anno Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 3 |
Collegamento che punta a una qualunque fine colonna Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 7 |
Come nascondere I Numeri non Appartenenti Al Mese Deside Autore: Maury170419 |
Forum: Applicazioni Office Windows Risposte: 3 |
Date CUP Web prenotabili su foglio excel Autore: aggittoriu |
Forum: Applicazioni Office Windows Risposte: 17 |
Visitano il forum: Nessuno e 74 ospiti