ancora trova e colora

[miko]

buona sera a tutti,
tra le tante macro disponibili nel forum ho cercato di modificare qualcuna
per adattarla al mio scopo, ma il risultato non è soddisfacente.
nel range O1-AD1 ho inserito alcuni numeri, disposti in ordine crescente da sinistra verso destra;
assegnata una generica riga, che ho chiamato NRow,
devo trovare questi numeri, su ciascuna riga, a partire da NRow-5, quindi 5 righe prima di NRow,
fino all'ultima riga UR del range C-H.
fin qui nulla di diverso dalle altre macro.
quello che non riesco a realizzare è colorare in modo diverso quando su una riga
i numeri da cercare sono singoli oppure formano ambi, terni, etc.
ho dovuto creare un seconda macro che ripete la ricerca per attribuire un diverso colore.
inoltre, trattandosi del superenalotto, i numeri di una riga del range C-H sono
in ordine crescente come nel range O1-AD1;
per logica ed al fine di velocizzare la ricerca ho tentato di procedere in questo modo:
supponiamo che i numeri da cercare siano 17-21-23-45-...
nella riga 115 contenente i seguenti numeri: 17-36-45-51-63-70
una volta trovato ed evidenziato il 17, è inutile continuare la ricerca-confronto con
i restanti numeri della riga 115, poichè non potrà esserci un altro 17;
devo allora passare a trovare il 21 a partire dal secondo numero della riga, il 36,
dal momento che il 17 è gia stato esaminato.
spero nella chiarezza del mio quesito.
ciao e grazie

[Flash30005]

E' opportuno l'invio del file da parte tua

ciao

[miko]

ciao e grazie del tuo intervento;
ho preparato questo file:
http://www.filedropper.com/trovaecolora
saluti, buona sera

[Flash30005]

Non mi sono chiare alcune cose anche perché riporti dei riferimenti che sul file inviato non ci sono (es. riga 115)
Prendiamo in esame il 17 (primo numero da ricercare nel range C8:H31
lo troviamo alla riga 10 e precisamente in C10
quindi suppongo vada colorato con colore X
La macro, quindi prosegue la ricerca sulla stessa riga 10 per cercare il 25
fino al numero 87 e non trova nulla, mentre trova nella stessa riga 10 il numero 90
colora il 90 ma poi cosa dovrebbe fare?

Ciao

[miko]

buona sera e buona domenica;
i riferimenti, come i numeri, citati nel mio post precedente erano solo esempi-indicazioni generali
utili al fine di una possibile chiarezza del quesito.
invio un nuovo file nel quale ho colorato le celle del range di ricerca C-H,
in modo da evidenziare il risultato finale della macro trova.

http://www.filedropper.com/trovaecolora1

nel range O1-AD1 inserisco dei numeri casuali che dispongo in ordine crescente;
tale range è generico nel senso che conosco la prima cella O1 ma non conosco l'ultima;
quindi si può avere O1-Z1, oppure O1-AF1 a seconda della quantità di numeri da cercare.
In questo esempio ho considerato come riga base la riga NRow=16 di colore grigio;
anche questa riga è generica e può essere la riga 25, oppure 115 od ancora la riga 1258,
per cui genericamente ho chiamato NRow.
devo trovare i numeri del range O1-AD1 nel range C-H a partire da 5 righe prima di NRow,colore grigio,
quindi nell'esempio, NRow-5=16-5=11, che ho colorato in viola,
fino all'ultima riga UR del range C-H.
quindi nell'esempio il range di ricerca sarebbe C11-H31; in generale scriverei (NRow-5,3)-(UR,8).
Quando su una singola riga si trova un solo numero lo evidenzio, ad esempio, in turchese;
se su una riga si trovano 2 numeri-ambo evidenzio i numeri in verde;
se i numeri formano un terno, evidenzio in giallo e così via secondo lo schema del range N2-N7.
Poichè sia i numeri di ciascuna riga del range C-H che quelli del range O1-AD1 sono disposti in ordine crescente,
quando su una riga di C-H viene trovato un numero uguale a quello di O1-AD1,
è inutile continuare la ricerca dello stesso numero sulla stessa riga
poichè non potrà esserci un altro numero identico;
passo allora a confrontare il numero successivo, sulla stessa riga di C-H, con i numeri successivi di O1-AD1.
per chiarezza, alla riga 17 trovo il primo numero 25, unico sulla stessa riga;
perciò è inutile continuare a cercare il 25 da E17 ad H17;
cerco invece il numero 32 di Q1 (range O1-AD1) da E17 ad H17;
quando poi trovo il 59 "riprendo" la ricerca sulla stessa riga, del 61 da G17 ad H17.
terminata la ricerca su una riga passo alla successiva di C-H.
buona serata e grazie

[Flash30005]

Prova questa macro

Codice: Seleziona tutto

Sub Colora()
Worksheets("ENALOTTO").Range("C8:H65536").Interior.ColorIndex = xlNone
RigaIni = Worksheets("ENALOTTO").Range("B1").Value - 5
RigaFine = Worksheets("ENALOTTO").Range("A" & Rows.Count).End(xlUp).Row
If RigaIni < 8 Then
MsgBox "Numero Riga troppo basso"
Exit Sub
End If
ColIni = 15
ColFine = Worksheets("ENALOTTO").Cells(1, Columns.Count).End(xlToLeft).Column
Dim VCol(6) As Integer
VCol(1) = 34
VCol(2) = 35
VCol(3) = 36
VCol(4) = 38
VCol(5) = 37
VCol(6) = 3
For RR1 = RigaIni To RigaFine
MyC = Evaluate("=SUM(COUNTIF(ENALOTTO!C" & RR1 & ":H" & RR1 & ",ENALOTTO!O1:IV1))")
If MyC > 0 Then
Tr = 0
Col = VCol(MyC)
For CCT = ColIni To ColFine
V1 = Worksheets("ENALOTTO").Cells(1, CCT).Value
    For CC1 = 3 To 8
        If Worksheets("ENALOTTO").Cells(RR1, CC1).Value = V1 Then
        Tr = Tr + 1
         Worksheets("ENALOTTO").Cells(RR1, CC1).Interior.ColorIndex = Col
         If Tr >= MyC Then GoTo SaltaRR1
        End If
    Next CC1
Next CCT
End If
SaltaRR1:
Next RR1
End Sub

Tieni presente che la tua "fantomatica" riga NRow deve essere digitata nella cella B2
Ciao

[miko]

salve,
la macro, chiara e concisa, funziona perfettamente, grazie;
aggiungo solo 1 precisazione, per un errore di distrazione e/o digitazione, e 2 ulteriori richieste;
secondo la terza linea di codice:
RigaIni = Worksheets("ENALOTTO").Range("B1").Value - 5
il valore della riga NRow deve essere digitata nella cella B1 e non B2;
è sufficiente tuttavia modificare i riferimenti.
Ho testato il codice su un numero elevato di righe ed ho notato che impiega molto tempo;
è possibile immaginare una riduzione del tempo di elaborazione?
come ultima richiesta vorrei introdurre nelle celle da O2 ad O7, a fianco della tabella singolo-sestina
la quantità di numeri singolo, ambi,...,sestine che vengono a formarsi,
a partire dalla riga successiva a quella in grigio, NRow, fino all'ultima riga;
nell'esempio inviato la riga grigia è la 16, per cui il conteggio dovrebbe iniziare dalla 17
fino alla 31.
ciao e grazie

[Flash30005]

Per velocizzare puoi inserire queste due righe codice prima dell'esecuzione della macro (dopo la condizione come indicato)

Codice: Seleziona tutto

Exit Sub  '<<< esistente
End If   '<<< esistente
Application.ScreenUpdating = False  '<<< aggiungere
Application.Calculation = xlManual   '<<< aggiungere
ColIni = 15  '<<< esistente


e queste due alla fine della macro per ripristinare il calcolo automatico e l'aggiornamento schermo

Codice: Seleziona tutto

Next RR1   '<<< esistente
Application.Calculation = xlCalculationAutomatic   '<<< aggiungere
Application.ScreenUpdating = True   '<<< aggiungere
End Sub  '<<< esistente


Per quanto riguarda il secondo quesito non mi è molto chiaro sul da farsi
Da O2 a O7 vorresti avere le frequenze del 17, e in P2, P7 le frequenze del 25?
Inoltre mi sembra di capire che la tua NRow sia "fissa" cioè sempre la riga 16 quindi non ti interessa averla variabile da impostare su B1 (?).
Poi spiega si deve avviare dalla riga 16 o dalla riga 16-5 cioè 11

ciao

[miko]

buona sera,
la macro è efficiente, ed anche la tua idea di variare la riga NRow inserendo il valore in B1 è ottima;
infatti questa NRow è variabile.
quindi la macro va bene così come l'hai realizzata.
provo a chiarire gli altri dubbi con esempi;
considera la riga 16 avvia la macro;
a partire dalla riga 17 fino alla 31 troverai nel range C-H un totale di:
numeri singoli (colore turchese)= 5
ambi(colore verde)=2
terni(colore giallo)=2
quaterne=1
cinquine=1
sestina =1
riporto questi valori in O2-O7.
cambiamo riga ad esempio NRow=20, cancelliamo O2-O7, cambia il munero di O1 in 18 per vedere le differenze;
a partire dalla riga 21 troverai in C-H:
numeri singoli = 4
ambi=1
terni=3
quaterne=0
cinquine=0
sestina =1
riporto questi totali in O2-O7.
quindi quello che vorrei evidenziare è il numero totale dei numeri singoli, ambi, ...sestine
che i numeri da cercare formano al cambiamento di riga NRow nel range C-H a partire da NRow+1
fino all'ultima riga.
buona serata e grazie

[Flash30005]

Ok, sono solo 2 righe da aggiungere ma invio la macro completa

Codice: Seleziona tutto

Sub Colora2()
RigaIni = Worksheets("ENALOTTO").Range("B1").Value - 5
RigaFine = Worksheets("ENALOTTO").Range("A" & Rows.Count).End(xlUp).Row
If RigaIni < 8 Then
MsgBox "Numero Riga troppo basso"
Exit Sub
End If
Worksheets("ENALOTTO").Range("C8:H65536").Interior.ColorIndex = xlNone
Worksheets("ENALOTTO").Range("O2:O7").ClearContents  '<<< aggiunta per pulizia totali in O2:O7
Application.ScreenUpdating = False
Application.Calculation = xlManual
ColIni = 15
ColFine = Worksheets("ENALOTTO").Cells(1, Columns.Count).End(xlToLeft).Column
Dim VCol(6) As Integer
VCol(1) = 34
VCol(2) = 35
VCol(3) = 36
VCol(4) = 38
VCol(5) = 37
VCol(6) = 3
For RR1 = RigaIni To RigaFine
MyC = Evaluate("=SUM(COUNTIF(ENALOTTO!C" & RR1 & ":H" & RR1 & ",ENALOTTO!O1:IV1))")
If MyC > 0 Then
Worksheets("ENALOTTO").Cells(MyC + 1, 15).Value = Worksheets("ENALOTTO").Cells(MyC + 1, 15).Value + 1  '<<<< aggiunta per conteggio frequenze
Tr = 0
Col = VCol(MyC)
For CCT = ColIni To ColFine
V1 = Worksheets("ENALOTTO").Cells(1, CCT).Value
    For CC1 = 3 To 8
        If Worksheets("ENALOTTO").Cells(RR1, CC1).Value = V1 Then
        Tr = Tr + 1
         Worksheets("ENALOTTO").Cells(RR1, CC1).Interior.ColorIndex = Col
         If Tr >= MyC Then GoTo SaltaRR1
        End If
    Next CC1
Next CCT
End If
SaltaRR1:
Next RR1
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Rimane invariata l'inizio riga (NRow) da digitare in B1
e se vuoi avviare la macro ogni volta cambi il valore in B1, puoi inserire nel Vba del foglio "Enalotto" (non nel modulo) questo codice

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$1" Then Exit Sub
Call Colora2
End Sub

Ciao

[Flash30005]

(Leggi post precedente)
Siccome la notte porta consiglio ho pensato di modificare la macro precedente spostando il conteggio freq da O2:O7 a M2:M7
lasciando così il range al di sotto dei numeri da cercare per ulteriori sviluppi ad esempio per conoscere la frequenza di ogni numero per tipologia di abbinamento quindi prova anche questa di macro e fai sapere

Codice: Seleziona tutto

Sub Colora2()
RigaIni = Worksheets("ENALOTTO").Range("B1").Value - 5
RigaFine = Worksheets("ENALOTTO").Range("A" & Rows.Count).End(xlUp).Row
If RigaIni < 8 Then
MsgBox "Numero Riga troppo basso"
Exit Sub
End If
Worksheets("ENALOTTO").Range("C8:H65536").Interior.ColorIndex = xlNone
Worksheets("ENALOTTO").Range("M1:M7").ClearContents
Application.ScreenUpdating = False
Application.Calculation = xlManual
Worksheets("ENALOTTO").Range("M1").Value = "Freq"
ColIni = 15
ColFine = Worksheets("ENALOTTO").Cells(1, Columns.Count).End(xlToLeft).Column
Worksheets("ENALOTTO").Range("O2:IV7").ClearContents
Dim VCol(6) As Integer
VCol(1) = 34
VCol(2) = 35
VCol(3) = 36
VCol(4) = 38
VCol(5) = 37
VCol(6) = 3
For RR1 = RigaIni To RigaFine
MyC = Evaluate("=SUM(COUNTIF(ENALOTTO!C" & RR1 & ":H" & RR1 & ",ENALOTTO!O1:IV1))")
If MyC > 0 Then
Worksheets("ENALOTTO").Cells(MyC + 1, 13).Value = Worksheets("ENALOTTO").Cells(MyC + 1, 13).Value + 1
Tr = 0
Col = VCol(MyC)
For CCT = ColIni To ColFine
V1 = Worksheets("ENALOTTO").Cells(1, CCT).Value
    For CC1 = 3 To 8
        If Worksheets("ENALOTTO").Cells(RR1, CC1).Value = V1 Then
        Worksheets("ENALOTTO").Cells(MyC + 1, CCT).Value = Worksheets("ENALOTTO").Cells(MyC + 1, CCT).Value + 1
        Tr = Tr + 1
         Worksheets("ENALOTTO").Cells(RR1, CC1).Interior.ColorIndex = Col
         If Tr >= MyC Then GoTo SaltaRR1
        End If
    Next CC1
Next CCT
End If
SaltaRR1:
Next RR1
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


In pratica ottieni questo output


Uploaded with ImageShack.us
Ciao

[miko]

buon giorno e buona domenica a tutti;
... e si la notte ti è gran consigliera;
in futuro posterò la sera ed attendere la soluzione il mattino successivo ;
le macro apprezzabili per compattezza e velocità funzionano molto bene;
in particolare l'ultima, avendo inserito la frequenza dei numeri, range O2-AD7,
non solo fornisce la presenza di ciascun numero nelle varie combinazioni,
ma, ad esempio considerando il terno nella fig da te mostrata, il 33 contribuisce 2 volte
nella formazione del terno;
sommando le presenze dei numeri e dividendo per 3 si ottiene il totale di M4;
davvero un ottima elaborazione ed intuizione; grazie.
solo una informazione, se e quando avrai tempo;
capisco che la linea:

Codice: Seleziona tutto

MyC = Evaluate("=SUM(COUNTIF(ENALOTTO!C" & RR1 & ":H" & RR1 & ",ENALOTTO!O1:IV1))")


esegue una "valutazione" ma non la interpreto;
ho notato che MyC assume un diverso valore al variare della riga ma non intuisco la relazione.
saluti e grazie ancora

[Flash30005]

COUNTIF(ENALOTTO!C" & RR1 & ":H" & RR1 & ",ENALOTTO!O1:IV1
RR1 cambia secondo il ciclo For next (da RigaIni a RigaFine)
Quindi conta se da C2:H2 quanti numeri ci sono riferiti al range O1:V1
Poi C3:H3 etc etc
In ogni passaggio c'è la condizione e se MyC è maggiore di 0 esegue la routine

Ciao

[miko]

buona sera,
dopo questo chiarimento comprendo meglio l'elaborazione delle macro,
e le loro velocità di esecuzione;
grazie per tutto il tuo contributo in questa mia richiesta.
ciao

[miko]

buona sera e saluti a tutto il forum,
con riferimento all'ultima linea di codice:

Codice: Seleziona tutto

MyC = Evaluate("=SUM(COUNTIF(ENALOTTO!C" & RR1 & ":H" & RR1 & ",ENALOTTO!O1:IV1))")

esaminata nelle ultime risposte di questo topic, ricordo che valutava-confrontava i valori contenuti nella riga
C-H, generica, con i valori contenuti nelle celle da O1 a IV1;
mi sono posto il problema di modificare il codice se i valori invece di essere contenuti nelle celle O1-IV1,
sono inseriti in un array;
supponiamo cioè di voler trovare i valori contenuti nell'array : MyArray(1,4,8,11)
nel range "C" & RR1 & ":H" & RR1 , essendo RR1 variabile nel ciclo;
ho provato a modificare la linea di codice al fine di ottenere qualcosa del tipo,
(scrivo impropriamente):
MyC = Evaluate("=SUM(COUNTIF(ENALOTTO!C" & RR1 & ":H" & RR1 & ",MyArray))")
oppure:
MyC = WorksheetFunction.CountIf(ENALOTTO!C" & RR1 & ":H" & RR1 & ",MyArray))")
ma non ottengo nulla oppure ho errore.
come devo modificare la linea?
ciao e grazie

[Anthony47]

Nell' ipotesi che stia parlando di un array contenente 4 valori, non di un array a 4 dimensioni, la cosa piu' semplice e' che scarichi il contenuto dell' array in 4 celle libere e poi usi queste 4 celle nella formula Evaluate; es.

Codice: Seleziona tutto

Range("AA1:AD1").Value = myArray
MyC = Evaluate("=SUM(COUNTIF(B1:H5,AA1:AD1))")

In alternativa dovrai fare un loop che usa Application.WorksheetFunction.CountIf:

Codice: Seleziona tutto

MyC = 0
For I = LBound(myArray, 1) To UBound(myArray, 1)
    MyC = MyC + Application.WorksheetFunction.CountIf(Sheets("Foglio1").Range("B1:H5"), myArray(I))
Next I

Questo secondo caso lo potresti applicare, previa aggiunta di altri 3 livelli di For /Next, anche al caso che si trattasse di un array a 4 dimensioni.

Ciao

[miko]

buonasera,
dopo aver inviato la mia richiesta ho continuato la ricerca-studio inerente il problema in questione;
a conferma del risultato fornito da anthony, vi informo, rivolgendomi in particolare a chi è
poco esperto come me del vba, dellle conclusioni a cui sono giunto, forse di utlità ad altri utenti:
la funzione COUNTIF non è applicabile direttamente agli array essendo una funzione relativa al worksheet;
pertanto lavora solo quando i valori sono contenuti in celle;
in tal senso è valida la prima soluzione di anthony che prima trasferisce i valori dell'array in celle
e successivamente applica la funzione COUNTIF;
se proprio si è caparbi come me a voler usare gli array allora è necessario eseguire un ciclo, loop, tra gli item
dell' array, applicando la funzione COUNTIF;
in questa ipotesi è valida la seconda soluzione di anthony.
alla parte teorica mi mancava quella "pratica" e conclusiva del quesito,
grazie.
saluti

[Anthony47]

Purtroppo ti devo dire che la teoria e' errata...
Il problema non sta' nel fatto che COUNTIF non puo' essere applicata a una array; ma che una FORMULA non puo' far riferimento ai dati contenuti in una variabile vba. Perche' quando tu scrivi Evaluate("=SUM(COUNTIF(B1:H5,AA1:AD1))") stai chiedendo al vba di elaborare appunto una formula.
Mentre sarebbe ammissibile, mettiamo, una istruzione tipo
MyCCC = Application.WorksheetFunction.CountIf(myArray(),Sheets("Enalotto").Range("H1").Value)

Comunque la pratica e' quella gia' detta.

Ciao