Comunque e' possibile che questa funzione possa fare il calcolo che dici:
- Codice: Seleziona tutto
Function GPSum(ByRef myArea As Range) As Variant
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=101754
Dim Cella As Range, I As Long, LVal, CCVal, myArr(1 To 4) As Integer, FStart As Boolean
Dim DiffCnt As Long, resArr(), myR As Long, LmyR As Long, FLexit As Boolean, NxVal, NNxVal
Dim ImyR As Long, JmyR As Long
'
ReDim resArr(1 To myArea.Rows.Count)
For myR = 1 To myArea.Rows.Count
CCVal = myArea.Cells(myR, 1).Value
If CCVal <> "" Then
myArr(CCVal) = 1
If Application.WorksheetFunction.Sum(myArr) = 4 Then
resArr(myR) = mysum + 1
FLexit = True
GoTo ExitA
End If
NxVal = "": NNxVal = ""
For ImyR = myR + 1 To myArea.Rows.Count
If NxVal = "" Then NxVal = myArea.Cells(ImyR, 1).Value
If NNxVal = "" Then NNxVal = myArea.Cells(ImyR + 1, 1).Value
If NxVal <> "" And NNxVal <> "" Then Exit For
Next ImyR
If (CCVal <> LVal And CCVal <> NxVal) Then 'Or (CCVal = LVal And CCVal <> NxVal And NxVal <> NNxVal) Then
FStart = True
End If
If FStart Then
mysum = mysum + 1
resArr(myR) = mysum
End If
LVal = CCVal
End If
ExitA:
If FLexit Then
FLexit = False
FStart = False
LVal = ""
mysum = 0
Erase myArr
End If
Next myR
GPSum = Application.WorksheetFunction.Transpose(resArr)
End Function
-inserisci la formula nella prima cella dei risultati; es in B3 inserisci =GPSum(A3:A30)-selezioni l' area completa, es da B3 a B30, premi F2, premi Contr-Maiusc-Enter
Eventuali modifiche alla formula vanno fatte selezionando tutte le celle che la contengono.
Ciao