Moderatori: Anthony47, Flash30005
Lucio Peruggini ha scritto:Ciao Avatar, ho provato anche questa e purtroppo marca un unico valore (1) su tutti gli eventi.
Per quanto riguarda la precedente, non mi risulta che in automatico compia quanto mi dici. Quando ha colorato i numeri inseriti, si ferma. Proverò ancora.
Grazie
http://screenshotuploader.com/s/t1y682wYXi9
Sub ColoraEContaRit()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UC = Worksheets("Archivio con Macro").Range("IV1").End(xlToLeft).Column
URD = Worksheets("Archivio con Macro").Range("C" & Rows.Count).End(xlUp).Row
Worksheets("Archivio con Macro").Range("C1:G" & URD).Interior.ColorIndex = xlNone
Worksheets("Archivio con Macro").Columns("I:I").ClearContents
Area = "C1:G" & URD
Ruota = ""
For CC = 12 To UC
ValC = Cells(1, CC).Value
For Each ValCa In Worksheets("Archivio con Macro").Range(Area)
If ValC = ValCa Then
ValCa.Interior.ColorIndex = 6
If Worksheets("Archivio con Macro").Cells(ValCa.Row, 9).Value = "" Then Worksheets("Archivio con Macro").Cells(ValCa.Row, 9).Value = 1
End If
Next
Next CC
For RR = 2 To URD
Ruota = Worksheets("Archivio con Macro").Range("B" & RR).Value
If MRuota <> Ruota Then
Worksheets("Archivio con Macro").Range("I" & RR).Value = 0
ContaR = 0
MRuota = Ruota
Else
If Worksheets("Archivio con Macro").Range("I" & RR).Value = "" Then
ContaR = ContaR + 1
Else
Worksheets("Archivio con Macro").Range("I" & RR).Value = ContaR + 1
ContaR = 0
End If
End If
Next RR
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Colora()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UC = Worksheets("Archivio con Macro").Range("IV1").End(xlToLeft).Column
URD = Worksheets("Archivio con Macro").Range("C" & Rows.Count).End(xlUp).Row
Worksheets("Archivio con Macro").Range("C1:G" & URD).Interior.ColorIndex = xlNone
Area = "C1:G" & URD
For CC = 12 To UC
ValC = Cells(1, CC).Value
For Each ValCa In Worksheets("Archivio con Macro").Range(Area)
If ValC = ValCa Then ValCa.Interior.ColorIndex = 6
Next
Next CC
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Call RitardiI
End Sub
Avatar3 ha scritto:Prima di accingermi a realizzare una macro (in questo caso non semplice)
vorrei sapere se i numeri nelle colonne C:G sono già stati elaborati con le macro precedenti e quindi sono evidenziati con fondo giallo.
Inoltre la distribuzione dell'archivio per ruota rende più complessa la soluzione perché immagino che il range concorso da te scelto debba scansionare tutte le ruote, vero?
Secondo me trovare una corretta soluzione richiede più tempo di quanto si possa immaginare
e non è così semplice come l'hai descritta tu
ci penserò
Ciao
Avatar3 ha scritto:Nel caso dovessimo trovare 3 numeri evidenziati nella stessa estrazione quindi ci ritroviamo 3 ambi cosa si deve fare?
Avatar3 ha scritto:Non è una questione di eliminare quello che è stato fatto
qui si parla di una nuova macro che cerca degli ambi
Negli esempi riportati ci sono 5 numeri da ricercare che combinati ina ambo formano 10 combinazioni
non solo, basandosi su un archivio di uscita del lotto i numeri non sono in ordine crescente
posso avere 5 e 90 come 90 e 5 quindi la verifica va fatta con i numeri rovesciati
ma, ripeto se invece di due soli numeri usciti su un'estrazione ne dovessi trovare 3 o 4
cosa dobbiamo mettere nella colonna J? Il ritardo del primo ambo?
considera che se sono 4 numeri centrati hai ben 6 ambi e la colonna è una sola
Consiglio sempre, in questi casi l'acquisto di programmi commerciali che con una modica spesa fanno analisi ben superiori e in minor tempo di quanto si possa immaginare di realizzare con un foglio di excel.
Sub RitAmbo()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Worksheets("Archivio con Macro").Range("A" & Rows.Count).End(xlUp).Row
If UR < 2 Then UR = 2
Worksheets("Archivio con Macro").Range("J2:J" & UR).ClearContents
Passo = 0
Dim Riga(2) As Integer
RigaI = Worksheets("Archivio con Macro").Range("J1").Value
RigaF = Worksheets("Archivio con Macro").Range("K1").Value
For RR = 2 To UR
If Worksheets("Archivio con Macro").Range("B" & RR).Value = "Ba" Then
Passo = Passo + 1
Else
GoTo SaltaRR
End If
Next RR
SaltaRR:
For RR = 2 To Passo
If RigaI = Worksheets("Archivio con Macro").Range("A" & RR).Value Then Riga(1) = RR
If RigaF = Worksheets("Archivio con Macro").Range("A" & RR).Value Then
Riga(2) = RR
GoTo SaltaRR2
End If
Next RR
SaltaRR2:
For TR = 0 To UR Step Passo
For RR = Riga(1) + TR To Riga(2) + TR
RigaI = Worksheets("Archivio con Macro").Range("J1").Value
Ca = 0
For CC = 3 To 7
If Worksheets("Archivio con Macro").Cells(RR, CC).Interior.ColorIndex = 6 Then
Ca = Ca + 1
If Ca = 1 Then Num1 = Format(Worksheets("Archivio con Macro").Cells(RR, CC).Value, "00")
If Ca = 2 Then
Num2 = Format(Worksheets("Archivio con Macro").Cells(RR, CC).Value, "00")
If Worksheets("Archivio con Macro").Cells(RR, 10).Value = "" Then Worksheets("Archivio con Macro").Cells(RR, 10).Value = Worksheets("Archivio con Macro").Cells(RR, 1).Value - RigaI
RigaI = Worksheets("Archivio con Macro").Cells(RR, 1).Value
For RRA = RR + 1 To Riga(2)
ContaA = 0
For CeA = 3 To 7
If Worksheets("Archivio con Macro").Cells(RRA, CeA).Interior.ColorIndex = 6 Then
ContaA = ContaA + 1
If ContaA = 1 Then NumA = Format(Worksheets("Archivio con Macro").Cells(RRA, CeA).Value, "00")
If ContaA = 2 Then
NumB = Format(Worksheets("Archivio con Macro").Cells(RRA, CeA).Value, "00")
If (Num1 = NumA And Num2 = NumB) Or (Num1 = NumB And Num2 = NumA) Then
If Worksheets("Archivio con Macro").Cells(RRA, 10).Value = "" Then Worksheets("Archivio con Macro").Cells(RRA, 10).Value = Worksheets("Archivio con Macro").Cells(RRA, 1).Value - RigaI
RigaI = Worksheets("Archivio con Macro").Cells(RRA, 1).Value
GoTo SaltaRRa
End If
End If
End If
Next CeA
SaltaRRa:
Next RRA
End If
End If
Next CC
Next RR
Next TR
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Torna a Applicazioni Office Windows
Calcolo numero giorni settimana nel periodo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 16 |
Calcolo del Bitrate per un formato CD Autore: franco11 |
Forum: Audio/Video e masterizzazione Risposte: 4 |
Visitano il forum: Nessuno e 82 ospiti