Adattamento macro

[Statix]

Ciao a tutti,
ho difficoltà ad adattare questa macro creata per 5 numeri,
volevo adattarla x 20 numeri, vedi foto
la macro, prima parte trova e colora in rosso il numero selezionato in E2,
successivamente trova il primo numero della terzina colorandolo di verde e restituire il numero indice della colonna A
in colonna AF

Codice: Seleziona tutto

Option Base 0
Public Urs, Vett(400, 20), Vr, ValN, NV As Integer
Dim myVARR              '<<<<

Sub NumeroE()
Application.ScreenUpdating = False
Application.EnableEvents = False
'Application.Calculation = xlCalculationManual
Range("Y5:AH1156").ClearContents


   
Urs = [A2] + 4
NV = [G2]
Range("D5:W1156").Interior.ColorIndex = 0
ValN = [E2]
'<<<<
Range("AF5").Resize(Urs, 1).ClearContents
myVARR = Range("A1:W" & Urs).Value



Vr = 0
For I = 0 To [H2]
For J = 0 To 5
Vett(I, J) = 0
Next J
Next I
Vett(0, 0) = 5
For RR = Urs To 1 Step -1
    For CC = 4 To 23
        If myVARR(RR, CC) = ValN Then

        Cells(RR, CC).Interior.ColorIndex = 3
        Vr = Vr + 1
        Vett(Vr, 0) = RR
        If NV = Vr Then GoTo salta
        End If
    Next CC
Next RR
salta:
   
        FlDue = 0
       
        For I = [G2] To 1 Step -1
        FlDue = 0
       
            For J = Vett(I, 0) + 1 To Urs
            If I > 1 And J > Vett(I - 1, 0) Then Exit For
           
            FlUno = 0
                For K = 19 To 0 Step -1
                    For L = 0 To [I1] - 1
                   
                       
                    If myVARR(J, 4 + K) = myVARR(2, 10 + L) Then '<<<
                      Cells(J, 1 + K).Interior.ColorIndex = 4
                      Cells(J, "AF").Value = Cells(J, "A").Value  '<<<<
                      FlUno = 1:
                      Vett(I, L + 1) = Vett(I, L + 1) + 1
                    End If
                    Next L

                Next K
                If FlUno > 0 Then FlDue = FlDue + 1
                If FlDue >= 1 Then GoTo NextRng
            Next J
NextRng:
        Next I
   
       
     
  Application.Calculation = xlCalculationAutomatic
Calculate
Application.EnableEvents = True
Application.ScreenUpdating = True



        End Sub

[Statix]

http://www.filedropper.com/10elotto5minutigeos2

[Anthony47]

Non ho capito certe scelte fatte nella macro, ne' se si tratta della versione per 5 colonne o per 20; quindi ho preferito scrivere un codice nuovo:

Codice: Seleziona tutto

Sub ProvaSta()
Dim wArr, aAF(), lastR As Long, I As Long, J As Long
Dim UB2 As Long, tVal As Long, Ter1 As Long
'
'mytim = Timer
lastR = Cells(Rows.Count, 1).End(xlUp).Row
wArr = Range("A1").Resize(lastR, 23).Value
ReDim aAF(LBound(wArr) To UBound(wArr), 1 To 1)
UB2 = UBound(wArr, 2)
tVal = Range("E2").Value
Ter1 = Range("J2")
Range(Range("D5"), Range("W" & lastR)).Interior.ColorIndex = xlNone
For I = 5 To lastR
    For J = 4 To UB2
        If wArr(I, J) = tVal Then
            Cells(I, J).Interior.Color = RGB(255, 0, 0)
        End If
        If wArr(I, J) = Ter1 Then
            aAF(I, 1) = wArr(I, 1)
            Cells(I, J).Interior.Color = RGB(0, 255, 0)
        End If
        If wArr(I, J) > tVal And wArr(I, J) > Ter1 Then Exit For
    Next J
Next I
Range("AF1").Resize(lastR, 1) = aAF
'MsgBox (Format(Timer - mytim, "0.00"))
End Sub


Prova e fai sapere...

[Statix]

Ciao Anthony47,
provata ma non fa quello che chiedo,
ricapitolando la macro deve trovare il numero range E2 e colorare i numeri in rosso nella tabella
successivamente deve trovare un numero qualsiasi della terzina subito dopo il numero in rosso
e colorarlo in verde restituendo in colonna AF l'indice della colonna A,
sarebbe comodo sistemare la macro che ti ho postato ,dopo la scritta salta:
la tua macro considera solo il primo numero della terzina,
dopo l'uscita del numero in rosso la macro deve colorare una sola volta un numero della terzina in verde

[Anthony47]

La macro guarda solo il primo numero della terzina perche' avevi detto che "successivamente trova il primo numero della terzina colorandolo di verde e restituire il numero indice della colonna A in colonna AF"

Variante:

Codice: Seleziona tutto

Sub ProvaSta2()
Dim wArr, aAF(), lastR As Long, I As Long, J As Long
Dim UB2 As Long, tVal As Long, TER1 As String
'
mytim = Timer
lastR = Cells(Rows.Count, 1).End(xlUp).Row
wArr = Range("A1").Resize(lastR, 23).Value
ReDim aAF(LBound(wArr) To UBound(wArr), 1 To 1)
UB2 = UBound(wArr, 2)
tVal = Range("E2").Value
TER1 = Format(Range("J2"), "00") & "_" & Format(Range("K2"), "00") & "_" & Format(Range("L2"), "00")
Range(Range("D5"), Range("W" & lastR)).Interior.ColorIndex = xlNone
For I = 5 To lastR
    For J = 4 To UB2
        If wArr(I, J) = tVal Then
            Cells(I, J).Interior.Color = RGB(255, 0, 0)
        End If
        If InStr(1, TER1, Format(wArr(I, J), "00"), vbTextCompare) > 0 Then
            aAF(I, 1) = wArr(I, 1)
            Cells(I, J).Interior.Color = RGB(0, 255, 0)
        End If
'        If wArr(I, J) > tVal And wArr(I, J) > Ter1 Then Exit For
    Next J
Next I
Range("AF1").Resize(lastR, 1) = aAF
'MsgBox (Format(Timer - mytim, "0.00"))
End Sub


[Statix]

Ciao Anthony47,
purtroppo non ci siamo,mi da i numeri ripetuti più volte,
questa macro adattata funziona benissimo i dati sono precisi,unico inconveniente è che i numeri usciti dopo quello rosso non vengono evidenziato in verde al posto giusto evidenzia altri numeri non facendo parte della terzina,
ripeto la macro li vede giusti ma non li colora,hai il file test metti la macro è prova.

Codice: Seleziona tutto

Option Base 0
Public Urs, Vett(300, 10), Vr, ValN, NV As Integer
Dim myVARR              '<<<<

Sub NumeroE()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Range("Y5:AH1156").ClearContents


   
Urs = [A2] + 4
NV = [G2]
Range("D5:W1156").Interior.ColorIndex = 0
ValN = [E2]
'<<<<
Range("AF5").Resize(Urs, 1).ClearContents
myVARR = Range("A1:W" & Urs).Value



Vr = 0
For I = 0 To [H2]
For J = 0 To 5
Vett(I, J) = 0
Next J
Next I
Vett(0, 0) = 4
For RR = Urs To 1 Step -1
    For CC = 4 To 23
        If myVARR(RR, CC) = ValN Then

        Cells(RR, CC).Interior.ColorIndex = 3
        Vr = Vr + 1
        Vett(Vr, 0) = RR
        If NV = Vr Then GoTo salta
        End If
    Next CC
Next RR
salta:
   
        FlDue = 0
       
        For I = [G2] To 1 Step -1
        FlDue = 0
       
            For J = Vett(I, 0) + 1 To Urs
            If I > 1 And J > Vett(I - 1, 0) Then Exit For
           
            FlUno = 0
                For K = 19 To 0 Step -1
                    For L = 0 To [I1]
                   
                       
                    If myVARR(J, 4 + K) = myVARR(2, 10 + L) Then '<<<
                      Cells(J, 1 + K).Interior.ColorIndex = 4
                      Cells(J, "AF").Value = Cells(J, "A").Value  '<<<<
                      FlUno = 1:
                      Vett(I, L + 1) = Vett(I, L + 1) + 1
                    End If
                    Next L

                Next K
                If FlUno > 0 Then FlDue = FlDue + 1
                If FlDue >= 1 Then GoTo NextRng
            Next J
NextRng:
        Next I
   
       
     
  Application.Calculation = xlCalculationAutomatic
Calculate
Application.EnableEvents = True
Application.ScreenUpdating = True



        End Sub

[Statix]

in questa foto,
dopo il 7 in rosso
la seconda riga dovrebbe colorarsi in verde 89 (numero della terzina)
la quarta il numero 90 in verde

[Statix]

ecco come dovrebbe essere

[Anthony47]

A me produce questo risultato (parlo della ProvaSta2)


Nel tuo esempio c'e' un motivo per cui non hai colorato in verde W9, W11 e molte altre celle successive che contengono 89 o 90?

La tua macro non l'ho capita, per questo non so correggerla.
Ciao

[Statix]

Dopo il numero spia in rosso in questo esempio 7 il primo numero della terzina o coppia che esce successivo al 7 diventa verde e passa alla spia successiva quindi non va a colorare tutti quelli successivi ma solo il primo che trova della terzina come detto prima la macro funziona bene unico cosa che non va e che non mi colora i numeri in verde

[Anthony47]

Eh, che dovesse evidenziare solo la prima occorrenza dopo il pilota dove era scritto?
Penultima versione:

Codice: Seleziona tutto

Sub ProvaSta3()
Dim wArr, aAF(), lastR As Long, I As Long, J As Long
Dim UB2 As Long, tVal As Long, TER1 As String, cPil As Boolean
'
mytim = Timer
lastR = Cells(Rows.Count, 1).End(xlUp).Row
wArr = Range("A1").Resize(lastR, 23).Value
ReDim aAF(LBound(wArr) To UBound(wArr), 1 To 1)
UB2 = UBound(wArr, 2)
tVal = Range("E2").Value
TER1 = Format(Range("J2"), "00") & "_" & Format(Range("K2"), "00") & "_" & Format(Range("L2"), "00")
Range(Range("D5"), Range("W" & lastR)).Interior.ColorIndex = xlNone
For I = 5 To lastR
    For J = 4 To UB2
        If wArr(I, J) = tVal Then
            Cells(I, J).Interior.Color = RGB(255, 0, 0)
            cPil = True
        End If
        If InStr(1, TER1, Format(wArr(I, J), "00"), vbTextCompare) > 0 And cPil Then
            aAF(I, 1) = wArr(I, 1)
            Cells(I, J).Interior.Color = RGB(0, 255, 0)
            cPil = False
        End If
    Next J
Next I
Range("AF1").Resize(lastR, 1) = aAF
''MsgBox (Format(Timer - mytim, "0.00"))
End Sub

Ciao

[Statix]

Ciao Anthony47,
se nella riga successiva al numero in rosso ci sono 2 o 3 numeri della terzina ,dovrebbe evidenziarli entrambi in verde

[Anthony47]

Per evidenziare tutti i numeri della terzina:

Codice: Seleziona tutto

Sub ProvaSta4()
Dim wArr, aAF(), lastR As Long, I As Long, J As Long
Dim UB2 As Long, tVal As Long, TER1 As String, cPil As Boolean, reCpil As Boolean
'
mytim = Timer
lastR = Cells(Rows.Count, 1).End(xlUp).Row
wArr = Range("A1").Resize(lastR, 23).Value
ReDim aAF(LBound(wArr) To UBound(wArr), 1 To 1)
UB2 = UBound(wArr, 2)
tVal = Range("E2").Value
TER1 = Format(Range("J2"), "00") & "_" & Format(Range("K2"), "00") & "_" & Format(Range("L2"), "00")
Range(Range("D5"), Range("W" & lastR)).Interior.ColorIndex = xlNone
For I = 5 To lastR
    For J = 4 To UB2
        If wArr(I, J) = tVal Then
            Cells(I, J).Interior.Color = RGB(255, 0, 0)
            cPil = True
        End If
        If InStr(1, TER1, Format(wArr(I, J), "00"), vbTextCompare) > 0 And cPil Then
            aAF(I, 1) = wArr(I, 1)
            Cells(I, J).Interior.Color = RGB(0, 255, 0)
            reCpil = True
        End If
'        If wArr(I, J) > tVal And wArr(I, J) > Ter1 Then Exit For
    Next J
    If reCpil Then cPil = False: reCpil = False
Next I
Range("AF1").Resize(lastR, 1) = aAF
MsgBox (Format(Timer - mytim, "0.00"))
End Sub


Quanto ai colori sparsi sulle colonne >100 non vedo come la macro possa applicarli, fermandosi la sua gestione alla colonna UBound(wArr, 2); essendo wArr popolato con Range("A1").Resize(lastR, 23).Value parliamo di colonna 23 max.
Non sono residui di elaborazioni precedenti??

Ciao

EDIT: vedo che i colori "sparsi" sembrano risolti; meglio cosi'

[Statix]

Ciao Anthony47,
tutto ok, perfetto come sempre
grazie

[Statix]

Ciao Anthony47,
ho riscontrato un piccolo errore della macro,
come mai ,dopo l'uscita del numero 88 (riga 1397)
non colora il numero 4 riga 1399) e non mi da l'indice 1399,
la chiusura è incompleta,

[Statix]

strano, all'improvviso sta funzionando,
vedo di fare altri test, per vedere se si ripete qualche errore.

,

[Statix]

l'errore si è ripetuto,
il 16 riga 1429 non è colorato in verde e non mi da l'indice,
ho usato la macro Provastat4 senza toccare nulla
anche il 16 riga 1422 non è colorato in verde e senza indice
ho capito il problema,
la macro non rileva il primo evento dopo la spia in rosso
dalla foto si vede che dopo la prima spia in rosso colora il primo evento ma poi va a colorare anche il secondo,
la procedura esatta apertura in rosso e chiusura in verde, come una coppia

[Anthony47]

Nel tuo esempio c'e' un motivo per cui non hai colorato in verde W9, W11 e molte altre celle successive che contengono 89 o 90?

Dopo il numero spia in rosso in questo esempio 7 il primo numero della terzina o coppia che esce successivo al 7 diventa verde e passa alla spia successiva quindi non va a colorare tutti quelli successivi ma solo il primo che trova della terzina come detto prima la macro funziona bene unico cosa che non va e che non mi colora i numeri in verde

Ma quello che vedi non e' quello che avevi chiesto??

[Statix]

questa è la sequenza giusta, salvo qualche svista.

[Anthony47]

Leggi il mio messaggio precedente...