La formula la inserico nella cella sottostante a l'ambo, risultato ritardo recende.
Saluti

Moderatori: Anthony47, Flash30005
Sub CalRitA()
UR = Range("B" & Rows.Count).End(xlUp).Row
Application.Calculation = xlManual
For CCA = 20 To 55
N1 = Cells(8, CCA).Value
N2 = Cells(9, CCA).Value
AmboC = N1 & "-" & N2
If N1 > N2 Then AmboC = N2 & "-" & N1
For RR = UR To 14 Step -1
For CCB = 2 To 6
NB1 = Cells(RR, CCB).Value
For CCC = CCB + 1 To 7
NB2 = Cells(RR, CCC).Value
AmboB = NB1 & "-" & NB2
If AmboB = AmboC Then
Application.EnableEvents = False
Cells(10, CCA).Value = (UR - RR)
Application.EnableEvents = True
GoTo SaltaCCA
End If
Next CCC
Next CCB
Next RR
SaltaCCA:
Next CCA
Application.Calculation = xlCalculationAutomatic
End Sub
=CERCA.ORIZZ(MAX(T4:BC4);T4:BC9;5;FALSO) &" " & CERCA.ORIZZ(MAX(T4:BC4);T4:BC9;6;FALSO)
Sub mimax()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=93777&p=591617#p591617
Dim WArr(1 To 49, 1 To 4) As Variant, myNums As Range, LastR As Long
Dim myR0 As Long, myC0 As Long, I As Long, J As Long, cCell, cRit As Long
'
Set myNums = Range("E11:K11") '<<< Il top dell' area con le estrazioni
myR0 = myNums.Cells(1, 1).Row
myC0 = myNums.Cells(1, 1).Column
LastR = myNums.Cells(1, 1).End(xlDown).Row
For I = myR0 To LastR
If I = 130 Then Stop
For J = myC0 To myC0 + myNums.Columns.Count - 1
cCell = Cells(I, J).Value
If IsEmpty(WArr(cCell, 4)) Then WArr(cCell, 4) = myR0 - 1
cRit = I - WArr(cCell, 4) - 1
WArr(cCell, 4) = I
If cRit > WArr(cCell, 2) Then
WArr(cCell, 2) = cRit
WArr(cCell, 3) = I
End If
Next J
Next I
For J = LBound(WArr, 1) To UBound(WArr, 1)
WArr(J, 1) = I - WArr(J, 4) - 1
Next J
'
Range("O11").Resize(49, 3) = WArr
Set myNums = Nothing
End Sub
Dim WArr(1 To 49, 1 To 4) As Variant, myNums As Range, LastR As Long
Dim myR0 As Long, myC0 As Long, I As Long, J As Long, cCell, cRit As Long
'
Set myNums = Range("E11:K11") '<<< Il top dell' area con le estrazioni
myR0 = myNums.Cells(1, 1).Row
myC0 = myNums.Cells(1, 1).Column
LastR = myNums.Cells(1, 1).End(xlDown).Row
For I = myR0 To LastR
If I = 130 Then Stop ' <<< si blocca qui...
For J = myC0 To myC0 + myNums.Columns.Count - 1
cCell = Cells(I, J).Value
If IsEmpty(WArr(cCell, 4)) Then WArr(cCell, 4) = myR0 - 1
cRit = I - WArr(cCell, 4) - 1
WArr(cCell, 4) = I
If cRit > WArr(cCell, 2) Then
WArr(cCell, 2) = cRit
WArr(cCell, 3) = I
End If
Next J
Next I
Sub mimax2()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=93777&p=591617#p591617
Dim WArr(1 To 49, 1 To 4) As Variant, myNums As Range, LastR As Long
Dim myR0 As Long, myC0 As Long, I As Long, J As Long, cCell, cRit As Long
'
Set myNums = Range("E11:K11")
myR0 = myNums.Cells(1, 1).Row
myC0 = myNums.Cells(1, 1).Column
LastR = myNums.Cells(1, 1).End(xlDown).Row
For I = LastR To myR0 Step -1
For J = myC0 To myC0 + myNums.Columns.Count - 1
cCell = Cells(I, J).Value
If IsEmpty(WArr(cCell, 4)) Then WArr(cCell, 4) = LastR + 1 'myR0 - 1
cRit = -(I - WArr(cCell, 4) + 1)
WArr(cCell, 4) = I
If cRit > WArr(cCell, 2) Then
WArr(cCell, 2) = cRit
WArr(cCell, 3) = I
End If
Next J
Next I
For J = LBound(WArr, 1) To UBound(WArr, 1)
WArr(J, 1) = -(I - WArr(J, 4) + 1)
Next J
Range("O11").Resize(49, 3) = WArr
Set myNums = Nothing
End Sub
Eh, caro... tutto sta a chiarire dove cominciano e dove finiscono le cose...
Torna a Applicazioni Office Windows
ruolo della costante nella formula della tendenza Autore: marcoc |
Forum: Applicazioni Office Windows Risposte: 1 |
Visitano il forum: Nessuno e 22 ospiti