Moderatori: Anthony47, Flash30005
=SE(MESE(B6)=MESE(B7);"";SE(SOMMA(SE(MESE($B$2:B6)=MESE(B6);$C$2:C6))>$E$2;SOMMA(SE(MESE($B$2:B6)=MESE(B6);$C$2:C6));""))
=SE(E(SOMMA(SE(A$2:A$100<=A2;C$2:C$100;""))>$E$2;SOMMA(D$1:D1)=0;A2<>A3);SOMMA(SE(A$2:A$100<=A2;C$2:C$100;""));"")
=SE(C2>E2;C2;0)
=SE(O(MESE(A3)<>MESE(A4);E(SOMMA(SE(MESE($A$2:$A3)=MESE(A3);$C$2:$C3;""))>$E$2;A3<A4;SOMMA(($D$2:D2)*(MESE(A$2:A2)=MESE(A3)))=0));SOMMA(SE(MESE($A$2:$A3)=MESE(A3);$C$2:$C3;""));0)
1) se il budget è raggiunto in un giorno diverso dall'ultimo giorno del mese allora vorrei che l'analisi riprendesse dal 1° giorno del mese successivo senza darmi il totale dell'ultimo giorno del mese (Es. se il 14 aprile è raggiunto il budget allora il 30 aprile non deve esserci nessun totale perché l'analisi deve ripartire dal 1° Maggio)
Finora ho immaginato un riepilogo annuale; quanto proposto funziona se non ci sono Mesi appartenenti a due anni diversi.2) Si possono esaminare sullo stesso foglio più anni assieme? Ho notato che la formula si ferma al 365° giorno per cui se io ad es in A e B oltre al 2017 ci metto anche il 2018 e copio le formule anche nel 2018, l'analisi non viene fatta.
=SE(E(SOMMA(SE(TESTO($A$2:$A3;"aaaamm")=TESTO(A3;"aaaamm");$C$2:$C3;""))>$E$2;A3<A4;SOMMA(($D$2:D2)*(TESTO(A$2:A2;"aaaamm")=TESTO(A3;"aaaamm")))=0);SOMMA(SE(TESTO($A$2:$A3;"aaaamm")=TESTO(A3;"aaaamm");$C$2:$C3;""));SE(E(MESE(A3)<>MESE(A4);SOMMA((D$2:D2)*(TESTO(A$2:A2;"aaaamm")=TESTO(A3;"aaaamm")))=0);SOMMA(SE(TESTO($A$2:$A3;"aaaamm")=TESTO(A3;"aaaamm");$C$2:$C3;""));0))
Sub CkBdg()
Dim WArr, RArr(), I As Long, cM As Integer, cY As Integer
Dim LY As Long, HY As Long, BuMen As Single, curD As Date
Dim bFlag As String, LastA As Long
'
bFlag = "F" '<<< La colonna in cui si marchera' l'OverBudg
BuMen = Range("E2").Value '<<< La cella col budget da verificare
'
LastA = Cells(Rows.Count, 1).End(xlUp).Row
Cells(2, bFlag).Resize(LastA + 10, 1).ClearContents
LY = Year(Application.WorksheetFunction.Min(Range("A:A")))
HY = Year(Application.WorksheetFunction.Max(Range("A:A")))
ReDim RArr(LY To HY, 1 To 12, 1 To 2)
'
For I = 2 To LastA
If IsDate(Cells(I, 1)) Then
curD = Cells(I, 1)
If Month(curD) <> cM And cM <> 0 Then
If RArr(cY, cM, 2) <> 1 Then
Cells(I - 1, bFlag).Value = RArr(cY, cM, 1)
End If
End If
cM = Month(curD)
cY = Year(curD)
RArr(cY, cM, 1) = RArr(cY, cM, 1) + Cells(I, 3).Value
If RArr(cY, cM, 1) > BuMen And Cells(I, 1) <> Cells(I + 1, 1) Then
If RArr(cY, cM, 2) <> 1 Then
Cells(I, bFlag).Value = RArr(cY, cM, 1)
RArr(cY, cM, 2) = 1
End If
End If
End If
Next I
Beep
End Sub
If Target.Count = 1 Then
If Target.Column = 1 Or Target.Column = 3 Then
Application.EnableEvents = False
Call CkBdg
Application.EnableEvents = False
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Target.Column = 1 Or Target.Column = 3 Then
Application.EnableEvents = False
Call CkBdg
Application.EnableEvents = True ' !!!
End If
End If
End Sub
For I = 2 To LastA
If IsDate(Cells(I, 1)) Then
curD = Cells(I, 1)
If Month(curD) <> cM And cM <> 0 Then
If RArr(cY, cM, 2) <> 2 Then ' !!!
Cells(I - 1, bFlag).Value = RArr(cY, cM, 1)
End If
Sub CkBdg()
Dim WArr, RArr(), I As Long, cM As Integer, cY As Integer
Dim LY As Long, HY As Long, BuMen As Single, curD As Date
Dim bFlag As String, LastA As Long
'
bFlag = "F" '<<< La colonna in cui si marchera' l'OverBudg
BuMen = Range("E2").Value '<<< La cella col budget da verificare
'
Debug.Print Timer
LastA = Cells(Rows.Count, 1).End(xlUp).Row
Cells(2, bFlag).Resize(LastA + 10, 2).ClearContents '+++ AZZERA 2 COLONNE
LY = Year(Application.WorksheetFunction.Min(Range("A:A")))
HY = Year(Application.WorksheetFunction.Max(Range("A:A")))
ReDim RArr(LY To HY, 1 To 12, 1 To 2)
'
For I = 2 To LastA
If IsDate(Cells(I, 1)) Then
curD = Cells(I, 1)
If Month(curD) <> cM And cM <> 0 Then
'' If RArr(cY, cM, 2) <> 1 Then '++++
Cells(I - 1, bFlag).Offset(0, 1).Value = RArr(cY, cM, 1) '+++
'' End If '+++
End If
cM = Month(curD)
cY = Year(curD)
RArr(cY, cM, 1) = RArr(cY, cM, 1) + Cells(I, 3).Value
If RArr(cY, cM, 1) > BuMen And Cells(I, 1) <> Cells(I + 1, 1) Then
If RArr(cY, cM, 2) <> 1 Then
Cells(I, bFlag).Value = RArr(cY, cM, 1)
RArr(cY, cM, 2) = 1
End If
End If
End If
Next I
End Sub
Sub CkBdg()
Dim WArr, RArr(), I As Long, cM As Integer, cY As Integer
Dim LY As Long, HY As Long, BuMen As Single, curD As Date
Dim bFlag As String, LastA As Long
'
bFlag = "F" '<<< La colonna in cui si marchera' l'OverBudg
BuMen = Range("E2").Value '<<< La cella col budget da verificare
'
LastA = Cells(Rows.Count, 1).End(xlUp).Row
Cells(2, bFlag).Resize(LastA + 10, 1).ClearContents
LY = Year(Application.WorksheetFunction.Min(Range("A:A")))
HY = Year(Application.WorksheetFunction.Max(Range("A:A")))
ReDim RArr(LY To HY, 1 To 12, 1 To 2)
'
For I = 2 To LastA
If IsDate(Cells(I, 1)) Then
curD = Cells(I, 1)
If Month(curD) <> cM And cM <> 0 Then
If RArr(cY, cM, 2) <> 1 Then
Cells(I - 1, bFlag).Value = RArr(cY, cM, 1)
End If
End If
cM = Month(curD)
cY = Year(curD)
RArr(cY, cM, 1) = RArr(cY, cM, 1) + Cells(I, 3).Value
If RArr(cY, cM, 1) > BuMen And Cells(I, 1) <> Cells(I + 1, 1) Then
If RArr(cY, cM, 2) <> 1 Then
Cells(I, bFlag).Value = RArr(cY, cM, 1)
RArr(cY, cM, 2) = 1
End If
End If
End If
Next I
Beep
End Sub
Sub CkBdg22()
'Overbudget in Col 1, mensile in colonna 2
Dim WArr, RArr(), I As Long, cM As Integer, cY As Integer
Dim LY As Long, HY As Long, BuMen As Single, curD As Date
Dim bFlag As String, LastA As Long
'
bFlag = "F" '<<< La colonna in cui si marchera' l'OverBudg
BuMen = Range("E2").Value '<<< La cella col budget da verificare
'
LastA = Cells(Rows.Count, 1).End(xlUp).Row
Cells(2, bFlag).Resize(LastA + 10, 2).ClearContents
LY = Year(Application.WorksheetFunction.Min(Range("A:A")))
HY = Year(Application.WorksheetFunction.Max(Range("A:A")))
ReDim RArr(LY To HY, 1 To 12, 1 To 2)
'
For I = 2 To LastA
If IsDate(Cells(I, 1)) Then
curD = Cells(I, 1)
If Month(curD) <> cM And cM <> 0 Then
Cells(I - 1, bFlag).Offset(0, 1).Value = RArr(cY, cM, 1)
If RArr(cY, cM, 2) <> 1 Then
Cells(I - 1, bFlag).Value = RArr(cY, cM, 1)
End If
End If
cM = Month(curD)
cY = Year(curD)
RArr(cY, cM, 1) = RArr(cY, cM, 1) + Cells(I, 3).Value
If RArr(cY, cM, 1) > BuMen And Cells(I, 1) <> Cells(I + 1, 1) Then
If RArr(cY, cM, 2) <> 1 Then
Cells(I, bFlag).Value = RArr(cY, cM, 1)
RArr(cY, cM, 2) = 1
End If
End If
End If
Next I
Beep
End Sub
Sub CkBdg22B()
'Overbudget in Col 1, mensile in colonna 2
Dim WArr, RArr(), I As Long, cM As Integer, cY As Integer
Dim LY As Long, HY As Long, BuMen As Single, curD As Date
Dim bFlag As String, LastA As Long
'
bFlag = "F" '<<< La colonna in cui si marchera' l'OverBudg
BuMen = Range("E2").Value '<<< La cella col budget da verificare
'
LastA = Cells(Rows.Count, 1).End(xlUp).Row
Cells(2, bFlag).Resize(LastA + 10, 2).ClearContents
LY = Year(Application.WorksheetFunction.Min(Range("A:A")))
HY = Year(Application.WorksheetFunction.Max(Range("A:A")))
ReDim RArr(LY To HY, 1 To 12, 1 To 2)
'
For I = 2 To LastA + 1
If IsDate(Cells(I, 1)) Or I >= LastA Then
curD = Cells(I, 1)
If (Month(curD) & Year(curD)) <> (cM & cY) And cM <> 0 Then
' Debug.Print I, cM, cY
Cells(I - 1, bFlag).Offset(0, 1).Value = RArr(cY, cM, 1)
If RArr(cY, cM, 2) <> 1 Then
Cells(I - 1, bFlag).Value = RArr(cY, cM, 1)
End If
End If
If I <= LastA Then
cM = Month(curD)
cY = Year(curD)
RArr(cY, cM, 1) = RArr(cY, cM, 1) + Cells(I, 3).Value
If RArr(cY, cM, 1) > BuMen And Cells(I, 1) <> Cells(I + 1, 1) Then
If RArr(cY, cM, 2) <> 1 Then
Cells(I, bFlag).Value = RArr(cY, cM, 1)
RArr(cY, cM, 2) = 1
End If
End If
End If
End If
Next I
Beep
End Sub
Sub CkBdg22B()
'Overbudget in Col 1, mensile in colonna 2
Dim WArr, RArr(), I As Long, cM As Integer, cY As Integer
Dim LY As Long, HY As Long, BuMen As Single, curD As Date
Dim bFlag As String, LastA As Long
'
bFlag = "F" '<<< La colonna in cui si marchera' l'OverBudg
BuMen = Range("E2").Value '<<< La cella col budget da verificare
'
LastA = Cells(Rows.Count, 1).End(xlUp).Row
Cells(2, bFlag).Resize(LastA + 10, 2).ClearContents
LY = Year(Application.WorksheetFunction.Min(Range("A:A")))
HY = Year(Application.WorksheetFunction.Max(Range("A:A")))
ReDim RArr(LY To HY, 1 To 12, 1 To 2)
'
For I = 2 To LastA + 1
If IsDate(Cells(I, 1)) Or I >= LastA Then
curD = Cells(I, 1)
If (Month(curD) & Year(curD)) <> (cM & cY) And cM <> 0 Then
' Debug.Print I, cM, cY
Cells(I - 1, bFlag).Offset(0, 1).Value = RArr(cY, cM, 1)
If RArr(cY, cM, 2) <> 1 Then
Cells(I - 1, bFlag).Value = RArr(cY, cM, 1)
End If
End If
If I <= LastA Then
cM = Month(curD)
cY = Year(curD)
RArr(cY, cM, 1) = RArr(cY, cM, 1) + Cells(I, 3).Value
If RArr(cY, cM, 1) > BuMen And Cells(I, 1) <> Cells(I + 1, 1) Then
If RArr(cY, cM, 2) <> 1 Then
Cells(I, bFlag).Value = RArr(cY, cM, 1)
RArr(cY, cM, 2) = 1
End If
End If
End If
End If
Next I
Beep
End Sub
Sub CkBdg33B()
'Overbudget in Col 1, mensile in colonna 2
Dim WArr, RArr(), I As Long, cM As Integer, cY As Integer
Dim LY As Long, HY As Long, BuMen As Single, curD As Date
Dim bFlag As String, LastA As Long
Dim dFlag As String, dCol As Long, dRow As Long
'
dFlag = "A2" '<<< La prima cella con le date; Modificare anche la Sub Worksheet_Change
bFlag = "F" '<<< La colonna in cui si marchera' l'OverBudg
BuMen = Range("G2").Value '<<< La cella col budget da verificare
'
dCol = Range(dFlag).Column
dRow = Range(dFlag).Row
LastA = Cells(Rows.Count, dCol).End(xlUp).Row
Cells(dRow, bFlag).Resize(LastA + 10, 2).ClearContents
LY = Year(Application.WorksheetFunction.Min(Range(dFlag).Resize(LastA, 1)))
HY = Year(Application.WorksheetFunction.Max(Range(dFlag).Resize(LastA, 1)))
ReDim RArr(LY To HY, 1 To 12, 1 To 2)
'
For I = dRow To LastA + 1
If IsDate(Cells(I, dCol)) Or I >= LastA Then
curD = Cells(I, dCol)
If (Month(curD) & Year(curD)) <> (cM & cY) And cM <> 0 Then
' Debug.Print I, cM, cY
Cells(I - 1, bFlag).Offset(0, 1).Value = RArr(cY, cM, 1)
If RArr(cY, cM, 2) <> 1 Then
Cells(I - 1, bFlag).Value = RArr(cY, cM, 1)
End If
End If
If I <= LastA Then
cM = Month(curD)
cY = Year(curD)
RArr(cY, cM, 1) = RArr(cY, cM, 1) + Cells(I, dCol + 2).Value
If RArr(cY, cM, 1) > BuMen And Cells(I, dCol) <> Cells(I + 1, dCol) Then
If RArr(cY, cM, 2) <> 1 Then
Cells(I, bFlag).Value = RArr(cY, cM, 1)
RArr(cY, cM, 2) = 1
End If
End If
End If
End If
Next I
Beep
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Colonna con la data iniziale:
dCol = 1 '<<< 1=A; 2=B; 3=C; etc
If Target.Count = 1 Then
If Target.Column = dCol Or Target.Column = dCol + 2 Or Target.Column = dCol + 4 Then
Application.EnableEvents = False
Call CkBdg33B
Application.EnableEvents = True
End If
End If
End Sub
Torna a Applicazioni Office Windows
cerca il più grande numero di celle vuote in un intervallo Autore: papiriof |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 59 ospiti