Ciao, chiedo sempre che sia possibile una modifica a questa macro fatta da dodo,per adattarla ad una ricerca quasi simile.
In pratica in questa abbiamo un foglio denominato "Inserimento" dove dalla cella A2:A300 andiamo ad inserire i numeri sortiti.
poi abbiamo un foglio denominato "Grafica e frequenza" dove nelle celle A2:A300 vengono riportati i numeri del foglio inserimento, nelle celle B2:B37 sono riportati i numeri fissi della roulette, C2:C37 le frequenze dei rispettivi numeri e nelle celle F2:F37 vorrei che venisse riportato il ritardo attuale e nelle celle G2:G37 ritardo storico.
Faccio un esempio: il numero 17 ha un ritardo attuale pari a 6 colpi mentre quello max storico è di 9 colpi. Quindi nella cella F18 riporterà il ritardo attuale pari a 6 mentre nella cella G18 il ritardo storico pari a 9.Per il conteggio si parte dall'ultimo numero in basso.
Ecco la macro fatta da dodo:
Option Explicit
Private Sub Worksheet_Activate()
Dim mRng As Range, Cel As Range, c As Object
Dim firstaddress As String, k As Byte
Dim mNum As Integer, ur As Long, ritS As Long, rPre As Long
Range("E2:F31,L2:M31,S2:T31").ClearContents
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Set mRng = Range("A2:A31,H2:H31,O2:O31")
ur = Sheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row
k = 0
For Each Cel In mRng
mNum = Cel.Value
With Worksheets("Foglio1").Range("B2:V" & ur)
Set c = .Find(mNum, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstaddress = c.Address
Do
If k = 0 Then
Cells(Cel.Row, Cel.Column + 4) = c.Row - 2
k = 1
ritS = c.Row - 2
rPre = c.Row
Else
If c.Row - rPre > ritS Then
ritS = c.Row - rPre
End If
rPre = c.Row
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
Cells(Cel.Row, Cel.Column + 5) = ritS
End If
End With
k = 0
ritS = 0
rPre = 0
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MsgBox "Fine elaborazione"
End Sub
Sub esi()
Application.EnableEvents = True
End Sub
Allego anche il file in excel
[Modificato da satos 21/05/2017 15:30]