Moderatori: Anthony47, Flash30005
Lucio Peruggini ha scritto:http://screenshotuploader.com/s/C5BoZVy7keI
Mi da errore ma chiedo:
Questa macro mi da la possibilità di impostare il range estrazionale sul quale vorrei il controllo?
Per fondo giallo intendi che gli ambi devono essere già evidenziati? In tal caso il procedimento è duplice:
Devo prima far partire una macro, poi l'altra; oppure ho spiegato malamente cosa essa dovrebbe cercare?
Questa, in base al rage estrazionale impostato e quindi su archivio non colorato deve con i numeri immessi nella prima riga per l'appunto cercare gli ambi, colorarli, e segnarmi il ritardo dall'estrazione di partenza.
Comunque, se è troppo complicato, lasciamo perdere. Non voglio rubarti tempo prezioso per cose futili come il lotto; anzi ti ringrazio per quanto e con pazienza hai già fatto.
Un caro saluto
For TR = 0 To UR Step Passo
For TR = 0 To UR - Passo Step Passo
For RRA = RR + 1 To Riga(2)
For RRA = RR + 1 To Riga(2) + TR
Lucio Peruggini ha scritto:http://screenshotuploader.com/s/XJsSwhpNrGO
Un pochino più difficile, ma non per voi!!!
Se necessita invio anche l'excel.
Grazie
Sub ColoraEContaRit4()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UC = Worksheets("Archivio con Macro").Range("IV1").End(xlToLeft).Column
UR = Worksheets("Archivio con Macro").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Archivio con Macro").Range("C1:G" & UR).Interior.ColorIndex = xlNone
Worksheets("Archivio con Macro").Columns("I:I").ClearContents
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 - Passo Step Passo
ContaR = 0
Area = "C" & Riga(1) + TR & ":G" & Riga(2) + TR
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 = Riga(1) + TR To Riga(2) + TR
RigaI = Worksheets("Archivio con Macro").Range("J1").Value
If Worksheets("Archivio con Macro").Range("A" & RR).Value = RigaI Then
ContaR = 0
Worksheets("Archivio con Macro").Range("I" & RR).Value = 0
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
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) + TR
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
For RR = 2 To Passo + 1 '<<<<<<<<<< aggiungere +1 qui, il resto lascia tutto come è
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
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 143 ospiti