Condividi:        

EXCEL Ricerca ed evidenzia coppie numeri

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

EXCEL Ricerca ed evidenzia coppie numeri

Postdi Francesco53 » 14/06/10 09:15

Buon giorno a tutto il Forum,
purtroppo non riesco a realizzare una macro che mi evidenzi quanto risulta dalle foto che allego:
Prima foto tabellone così come costruito
Immagine
Alla decima estrazione del mese, colonna B, a destra mi calcola delle coppie di numeri.
Seconda foto tabellone così come devrebbe essere dopo i rilevamenti dei numeri
Immagine
Come si evidenzia, ricerca tra la decima estrazione e la successiva, le coppie dei numeri a destra,
se presenti come coppia, entro la prossima decima estrazione, li evidenzia in blu e scrive il
numero 1 nella colonna H e nella riga di appartenenza 28 (H28).
Ringrazio chi potrà aiutarmi.
Francesco
S.O. Windows 10 e Office 2007
Avatar utente
Francesco53
Utente Senior
 
Post: 811
Iscritto il: 20/02/10 18:45

Sponsor
 

Re: EXCEL Ricerca ed evidenzia coppie numeri

Postdi Flash30005 » 14/06/10 09:33

1) Non è ben specificato se il rilevamento deve iniziare dalla stessa riga dei numeri o da quella successiva
Es.: serie di numeri da cercare sono sulla riga 14, la ricerca di questa serie inizia dalla riga 14 o dalla 15?

2) parli di ricerca entro la prossima decima estrazione quando l'intervallo esistente tra le serie è inizialmente di 12 righe (quindi 12 estrazione) poi di 14... come mai?
La ricerca non deve tenere conto di questi passi variabili?

3) sarebbe opportuno l'invio, da parte tua, del file, eviteresti di farci compilare un foglio per effettuare i test


ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: EXCEL Ricerca ed evidenzia coppie numeri

Postdi Francesco53 » 14/06/10 11:07

Ciao Flash,
ti allego file esempio
http://www.megaupload.com/?d=ZECZ1XFA
Rispondo alle tue domande:
1) Il rilevamento deve iniziare dalla riga successiva a quella dei numeri,
e corrisponderà alla estrazione n. 11 del mese.
2) Confermo che la ricerca deve andare dalla 11 estrazione alla 10 del
mese successivo, pertanto come potrai notare varia il numero delle
estrazioni, infatti come scrivi tu, a volte possono essere 9, 10 sino a 14.
Ciao e grazie a tutti voi per la disponibilità
Francesco
S.O. Windows 10 e Office 2007
Avatar utente
Francesco53
Utente Senior
 
Post: 811
Iscritto il: 20/02/10 18:45

Re: EXCEL Ricerca ed evidenzia coppie numeri

Postdi Flash30005 » 14/06/10 15:34

Prova questa macro e fai sapere

Codice: Seleziona tutto
Sub TrovaA()
Dim VNR(9) As String
Dim VNE(5) As String
Dim Amb(9) As String
UR = Sheets("Ambi").Range("B" & Rows.Count).End(xlUp).Row
Range("C5:G" & UR).Font.ColorIndex = 0
Columns("H:H").ClearContents
For RR = 5 To UR
If RR = 36 Then MsgBox RR
ValC = Range("B" & RR).Value
If ValC = "" Then GoTo esci
If ValC = 10 Then
ValV = 0
For CNR = 9 To 18 Step 3
ValV = ValV + 2
VNR(ValV) = Format(Cells(RR, CNR).Value, "00")
VNR(ValV + 1) = Format(Cells(RR, CNR + 1).Value, "00")
Amb(ValV) = VNR(ValV) & VNR(ValV + 1)
Amb(ValV + 1) = VNR(ValV + 1) & VNR(ValV)
Next CNR
For RRE = RR + 1 To RR + 16
ValC2 = Range("B" & RRE).Value
If ValC2 = "" Then GoTo esci
If ValC2 = 10 Then
RR = RRE - 1
GoTo salta
End If
For CE1 = 3 To 3
VNE(CE1 - 2) = Format(Cells(RRE, CE1).Value, "00")
For CE2 = CE1 + 1 To 4
VNE(CE2 - 2) = Format(Cells(RRE, CE2).Value, "00")
For CE3 = CE2 + 1 To 5
VNE(CE3 - 2) = Format(Cells(RRE, CE3).Value, "00")
For CE4 = CE3 + 1 To 6
VNE(CE4 - 2) = Format(Cells(RRE, CE4).Value, "00")
For CE5 = CE4 + 1 To 7
VNE(CE5 - 2) = Format(Cells(RRE, CE5).Value, "00")

AE1 = VNE(CE1 - 2) & VNE(CE2 - 2)
AE2 = VNE(CE1 - 2) & VNE(CE3 - 2)
AE3 = VNE(CE1 - 2) & VNE(CE4 - 2)
AE4 = VNE(CE1 - 2) & VNE(CE5 - 2)
AE5 = VNE(CE2 - 2) & VNE(CE3 - 2)
AE6 = VNE(CE2 - 2) & VNE(CE4 - 2)
AE7 = VNE(CE2 - 2) & VNE(CE5 - 2)
AE8 = VNE(CE3 - 2) & VNE(CE4 - 2)
AE9 = VNE(CE3 - 2) & VNE(CE5 - 2)
Ae10 = VNE(CE5 - 2) & VNE(CE4 - 2)
For Ciclo = 2 To 9 Step 2
If Amb(Ciclo) = AE1 Or Amb(Ciclo + 1) = AE1 Then
Range("H" & RRE).Value = Range("H" & RRE).Value + 1
Cells(RRE, CE1).Font.ColorIndex = 41
Cells(RRE, CE2).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE2 Or Amb(Ciclo + 1) = AE2 Then
Range("H" & RRE).Value = Range("H" & RRE).Value + 1
Cells(RRE, CE1).Font.ColorIndex = 41
Cells(RRE, CE3).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE3 Or Amb(Ciclo + 1) = AE3 Then
Range("H" & RRE).Value = Range("H" & RRE).Value + 1
Cells(RRE, CE1).Font.ColorIndex = 41
Cells(RRE, CE4).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE4 Or Amb(Ciclo + 1) = AE4 Then
Range("H" & RRE).Value = Range("H" & RRE).Value + 1
Cells(RRE, CE1).Font.ColorIndex = 41
Cells(RRE, CE5).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE5 Or Amb(Ciclo + 1) = AE5 Then
Range("H" & RRE).Value = Range("H" & RRE).Value + 1
Cells(RRE, CE2).Font.ColorIndex = 41
Cells(RRE, CE3).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE6 Or Amb(Ciclo + 1) = AE6 Then
Range("H" & RRE).Value = Range("H" & RRE).Value + 1
Cells(RRE, CE2).Font.ColorIndex = 41
Cells(RRE, CE4).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE7 Or Amb(Ciclo + 1) = AE7 Then
Range("H" & RRE).Value = Range("H" & RRE).Value + 1
Cells(RRE, CE2).Font.ColorIndex = 41
Cells(RRE, CE5).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE8 Or Amb(Ciclo + 1) = AE8 Then
Range("H" & RRE).Value = Range("H" & RRE).Value + 1
Cells(RRE, CE3).Font.ColorIndex = 41
Cells(RRE, CE4).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE9 Or Amb(Ciclo + 1) = AE9 Then
Range("H" & RRE).Value = Range("H" & RRE).Value + 1
Cells(RRE, CE3).Font.ColorIndex = 41
Cells(RRE, CE5).Font.ColorIndex = 41
End If
If Amb(Ciclo) = Ae10 Or Amb(Ciclo + 1) = Ae10 Then
Range("H" & RRE).Value = Range("H" & RRE).Value + 1
Cells(RRE, CE4).Font.ColorIndex = 41
Cells(RRE, CE5).Font.ColorIndex = 41
End If
Next Ciclo
'MsgBox Amb(2) & Amb(4) & Amb(6) & Amb(8)
'MsgBox AE1 & AE2 & AE3 & AE4 & AE5 & AE6 & AE7 & AE8 & AE9 & AE9 & Ae10
Next CE5
Next CE4
Next CE3
Next CE2
Next CE1
Next RRE
End If
salta:
Next RR
esci:
End Sub


Ciao

Ps. Togli la formattazione condizionata nella tabella delle estrazioni
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: EXCEL Ricerca ed evidenzia coppie numeri

Postdi Francesco53 » 14/06/10 16:33

Grazie Flash, è perfetta.
Un grande saluto
Francesco
S.O. Windows 10 e Office 2007
Avatar utente
Francesco53
Utente Senior
 
Post: 811
Iscritto il: 20/02/10 18:45

Re: EXCEL Ricerca ed evidenzia coppie numeri

Postdi Francesco53 » 18/06/10 13:48

Ciao Flash, avevo la necessità di chiederti un aiuto per la tua macro, funziona benissimo,
solo che volevo inserire una nuova colonna in A, ho predisposto nelle cella X2, la possibilità di variare
il num da cui iniziare a ricercare gli accoppiamenti, ed ho cercato di variare la macro, purtroppo l'esito
non è stato dei migliori. Continua a ricercare dalla colonna C alla colonna G, mentre dovrebbe ricercare
dalla colonna D alla H. Allego modifica macro, se puoi per favore verificare cosa non ho modificato per
ottenere i giusti risultati.
Codice: Seleziona tutto
Sub Ricerca()
    Dim VNR(9) As String
    Dim VNE(5) As String
    Dim Amb(9) As String
    UR = Sheets("Ricerca").Range("C" & Rows.Count).End(xlUp).Row
    Range("D5:H" & UR).Font.ColorIndex = 0
    Columns("I:I").ClearContents
    PF = Range("X2").Value
    For RR = 5 To UR
    If RR = 36 Then MsgBox RR
    ValC = Range("C" & RR).Value
    If ValC = "" Then GoTo esci
    If ValC = PF Then
    ValV = 0
    For CNR = 10 To 19 Step 3   ' 9 TO 18
    ValV = ValV + 2
    VNR(ValV) = Format(Cells(RR, CNR).Value, "00")
    VNR(ValV + 1) = Format(Cells(RR, CNR + 1).Value, "00")
    Amb(ValV) = VNR(ValV) & VNR(ValV + 1)
    Amb(ValV + 1) = VNR(ValV + 1) & VNR(ValV)
    Next CNR
    For RRE = RR + 1 To RR + 16
    ValC2 = Range("C" & RRE).Value
    If ValC2 = "" Then GoTo esci
    If ValC2 = PF Then
    RR = RRE - 1
    GoTo salta
    End If
    For CE1 = 3 To 3
    VNE(CE1 - 3) = Format(Cells(RRE, CE1).Value, "00")
    For CE2 = CE1 + 1 To 4
    VNE(CE2 - 3) = Format(Cells(RRE, CE2).Value, "00")
    For CE3 = CE2 + 1 To 5
    VNE(CE3 - 3) = Format(Cells(RRE, CE3).Value, "00")
    For CE4 = CE3 + 1 To 6
    VNE(CE4 - 3) = Format(Cells(RRE, CE4).Value, "00")
    For CE5 = CE4 + 1 To 7
    VNE(CE5 - 3) = Format(Cells(RRE, CE5).Value, "00")

    AE1 = VNE(CE1 - 3) & VNE(CE2 - 3)
    AE2 = VNE(CE1 - 3) & VNE(CE3 - 3)
    AE3 = VNE(CE1 - 3) & VNE(CE4 - 3)
    AE4 = VNE(CE1 - 3) & VNE(CE5 - 3)
    AE5 = VNE(CE2 - 3) & VNE(CE3 - 3)
    AE6 = VNE(CE2 - 3) & VNE(CE4 - 3)
    AE7 = VNE(CE2 - 3) & VNE(CE5 - 3)
    AE8 = VNE(CE3 - 3) & VNE(CE4 - 3)
    AE9 = VNE(CE3 - 3) & VNE(CE5 - 3)
    Ae10 = VNE(CE5 - 3) & VNE(CE4 - 3)
    For Ciclo = 2 To 9 Step 2
    If Amb(Ciclo) = AE1 Or Amb(Ciclo + 1) = AE1 Then
    Range("I" & RRE).Value = Range("I" & RRE).Value + 1
    Cells(RRE, CE1).Font.ColorIndex = 41
    Cells(RRE, CE2).Font.ColorIndex = 41
    End If
    If Amb(Ciclo) = AE2 Or Amb(Ciclo + 1) = AE2 Then
    Range("I" & RRE).Value = Range("I" & RRE).Value + 1
    Cells(RRE, CE1).Font.ColorIndex = 41
    Cells(RRE, CE3).Font.ColorIndex = 41
    End If
    If Amb(Ciclo) = AE3 Or Amb(Ciclo + 1) = AE3 Then
    Range("I" & RRE).Value = Range("I" & RRE).Value + 1
    Cells(RRE, CE1).Font.ColorIndex = 41
    Cells(RRE, CE4).Font.ColorIndex = 41
    End If
    If Amb(Ciclo) = AE4 Or Amb(Ciclo + 1) = AE4 Then
    Range("I" & RRE).Value = Range("I" & RRE).Value + 1
    Cells(RRE, CE1).Font.ColorIndex = 41
    Cells(RRE, CE5).Font.ColorIndex = 41
    End If
    If Amb(Ciclo) = AE5 Or Amb(Ciclo + 1) = AE5 Then
    Range("I" & RRE).Value = Range("I" & RRE).Value + 1
    Cells(RRE, CE2).Font.ColorIndex = 41
    Cells(RRE, CE3).Font.ColorIndex = 41
    End If
    If Amb(Ciclo) = AE6 Or Amb(Ciclo + 1) = AE6 Then
    Range("I" & RRE).Value = Range("I" & RRE).Value + 1
    Cells(RRE, CE2).Font.ColorIndex = 41
    Cells(RRE, CE4).Font.ColorIndex = 41
    End If
    If Amb(Ciclo) = AE7 Or Amb(Ciclo + 1) = AE7 Then
    Range("I" & RRE).Value = Range("I" & RRE).Value + 1
    Cells(RRE, CE2).Font.ColorIndex = 41
    Cells(RRE, CE5).Font.ColorIndex = 41
    End If
    If Amb(Ciclo) = AE8 Or Amb(Ciclo + 1) = AE8 Then
    Range("I" & RRE).Value = Range("I" & RRE).Value + 1
    Cells(RRE, CE3).Font.ColorIndex = 41
    Cells(RRE, CE4).Font.ColorIndex = 41
    End If
    If Amb(Ciclo) = AE9 Or Amb(Ciclo + 1) = AE9 Then
    Range("I" & RRE).Value = Range("I" & RRE).Value + 1
    Cells(RRE, CE3).Font.ColorIndex = 41
    Cells(RRE, CE5).Font.ColorIndex = 41
    End If
    If Amb(Ciclo) = Ae10 Or Amb(Ciclo + 1) = Ae10 Then
    Range("I" & RRE).Value = Range("I" & RRE).Value + 1
    Cells(RRE, CE4).Font.ColorIndex = 41
    Cells(RRE, CE5).Font.ColorIndex = 41
    End If
    Next Ciclo
    'MsgBox Amb(2) & Amb(4) & Amb(6) & Amb(8)
    'MsgBox AE1 & AE2 & AE3 & AE4 & AE5 & AE6 & AE7 & AE8 & AE9 & AE9 & Ae10
    Next CE5
    Next CE4
    Next CE3
    Next CE2
    Next CE1
    Next RRE
    End If
salta:
    Next RR
esci:
    End Sub

Ti ringrazio comunque per quanto già fatto per la mia richiesta.
Un caro saluto
Francesco
S.O. Windows 10 e Office 2007
Avatar utente
Francesco53
Utente Senior
 
Post: 811
Iscritto il: 20/02/10 18:45

Re: EXCEL Ricerca ed evidenzia coppie numeri

Postdi Flash30005 » 18/06/10 15:12

Beh, ti invio la macro corretta, così la verifica per vedere cosa non avevi corretto la fai tu
Codice: Seleziona tutto
Sub TrovaA()
Dim VNR(9) As String
Dim VNE(5) As String
Dim Amb(9) As String
UR = Sheets("Ambi").Range("B" & Rows.Count).End(xlUp).Row
Range("D5:H" & UR).Font.ColorIndex = 0
Columns("I:I").ClearContents
For RR = 5 To UR
ValC = Range("C" & RR).Value
If ValC = "" Then GoTo esci
If ValC = 10 Then
ValV = 0
For CNR = 10 To 19 Step 3
ValV = ValV + 2
VNR(ValV) = Format(Cells(RR, CNR).Value, "00")
VNR(ValV + 1) = Format(Cells(RR, CNR + 1).Value, "00")
Amb(ValV) = VNR(ValV) & VNR(ValV + 1)
Amb(ValV + 1) = VNR(ValV + 1) & VNR(ValV)
Next CNR
For RRE = RR + 1 To RR + 16
ValC2 = Range("C" & RRE).Value
If ValC2 = "" Then GoTo esci
If ValC2 = 10 Then
RR = RRE - 1
GoTo salta
End If
For CE1 = 4 To 4
VNE(CE1 - 3) = Format(Cells(RRE, CE1).Value, "00")
For CE2 = CE1 + 1 To 5
VNE(CE2 - 3) = Format(Cells(RRE, CE2).Value, "00")
For CE3 = CE2 + 1 To 6
VNE(CE3 - 3) = Format(Cells(RRE, CE3).Value, "00")
For CE4 = CE3 + 1 To 7
VNE(CE4 - 3) = Format(Cells(RRE, CE4).Value, "00")
For CE5 = CE4 + 1 To 8
VNE(CE5 - 3) = Format(Cells(RRE, CE5).Value, "00")

AE1 = VNE(CE1 - 3) & VNE(CE2 - 3)
AE2 = VNE(CE1 - 3) & VNE(CE3 - 3)
AE3 = VNE(CE1 - 3) & VNE(CE4 - 3)
AE4 = VNE(CE1 - 3) & VNE(CE5 - 3)
AE5 = VNE(CE2 - 3) & VNE(CE3 - 3)
AE6 = VNE(CE2 - 3) & VNE(CE4 - 3)
AE7 = VNE(CE2 - 3) & VNE(CE5 - 3)
AE8 = VNE(CE3 - 3) & VNE(CE4 - 3)
AE9 = VNE(CE3 - 3) & VNE(CE5 - 3)
Ae10 = VNE(CE5 - 3) & VNE(CE4 - 3)
For Ciclo = 2 To 9 Step 2
If Amb(Ciclo) = AE1 Or Amb(Ciclo + 1) = AE1 Then
Range("I" & RRE).Value = Range("I" & RRE).Value + 1
Cells(RRE, CE1).Font.ColorIndex = 41
Cells(RRE, CE2).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE2 Or Amb(Ciclo + 1) = AE2 Then
Range("I" & RRE).Value = Range("I" & RRE).Value + 1
Cells(RRE, CE1).Font.ColorIndex = 41
Cells(RRE, CE3).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE3 Or Amb(Ciclo + 1) = AE3 Then
Range("I" & RRE).Value = Range("I" & RRE).Value + 1
Cells(RRE, CE1).Font.ColorIndex = 41
Cells(RRE, CE4).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE4 Or Amb(Ciclo + 1) = AE4 Then
Range("I" & RRE).Value = Range("I" & RRE).Value + 1
Cells(RRE, CE1).Font.ColorIndex = 41
Cells(RRE, CE5).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE5 Or Amb(Ciclo + 1) = AE5 Then
Range("I" & RRE).Value = Range("I" & RRE).Value + 1
Cells(RRE, CE2).Font.ColorIndex = 41
Cells(RRE, CE3).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE6 Or Amb(Ciclo + 1) = AE6 Then
Range("I" & RRE).Value = Range("I" & RRE).Value + 1
Cells(RRE, CE2).Font.ColorIndex = 41
Cells(RRE, CE4).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE7 Or Amb(Ciclo + 1) = AE7 Then
Range("I" & RRE).Value = Range("I" & RRE).Value + 1
Cells(RRE, CE2).Font.ColorIndex = 41
Cells(RRE, CE5).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE8 Or Amb(Ciclo + 1) = AE8 Then
Range("I" & RRE).Value = Range("I" & RRE).Value + 1
Cells(RRE, CE3).Font.ColorIndex = 41
Cells(RRE, CE4).Font.ColorIndex = 41
End If
If Amb(Ciclo) = AE9 Or Amb(Ciclo + 1) = AE9 Then
Range("I" & RRE).Value = Range("I" & RRE).Value + 1
Cells(RRE, CE3).Font.ColorIndex = 41
Cells(RRE, CE5).Font.ColorIndex = 41
End If
If Amb(Ciclo) = Ae10 Or Amb(Ciclo + 1) = Ae10 Then
Range("I" & RRE).Value = Range("I" & RRE).Value + 1
Cells(RRE, CE4).Font.ColorIndex = 41
Cells(RRE, CE5).Font.ColorIndex = 41
End If
Next Ciclo
'MsgBox Amb(2) & Amb(4) & Amb(6) & Amb(8)
'MsgBox AE1 & AE2 & AE3 & AE4 & AE5 & AE6 & AE7 & AE8 & AE9 & AE9 & Ae10
Next CE5
Next CE4
Next CE3
Next CE2
Next CE1
Next RRE
End If
salta:
Next RR
esci:
End Sub


Fai sapere se Ok
ciao

P.s. Ma era proprio necessario aggiungere una colonna a sinistra dell'archivio?
(Inserita sulla destra non c'era alcun bisogno di modifica)
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: EXCEL Ricerca ed evidenzia coppie numeri

Postdi Francesco53 » 18/06/10 15:44

Grazie Flash, è tutto OK.
Francesco
S.O. Windows 10 e Office 2007
Avatar utente
Francesco53
Utente Senior
 
Post: 811
Iscritto il: 20/02/10 18:45


Torna a Applicazioni Office Windows


Topic correlati a "EXCEL Ricerca ed evidenzia coppie numeri":


Chi c’è in linea

Visitano il forum: Nessuno e 52 ospiti