Pagina precedente | 1 | Pagina successiva
Vota | Stampa | Notifica email    
Autore

Excel macro modifica se

Ultimo Aggiornamento: 22/05/2017 12:36
Post: 193
Registrato il: 29/04/2002
Utente Junior
2007
OFFLINE
21/05/2017 01:04

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]
Vota: 15MediaObject5,00718 7
Amministra Discussione: | Chiudi | Sposta | Cancella | Modifica | Notifica email Pagina precedente | 1 | Pagina successiva
Nuova Discussione
 | 
Rispondi
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 06:36. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com