VBA ricerca multipla

Hai un problema con Excel?

Nuova discussione

VBA ricerca multipla
di Attilio data: 21/03/2013 10:45:28
Ciao, con le formule di excel è lunga da fare, passo alla spiegazione:

dalla cella A1 alla cella A12 ci sono vari numeri, dalla cella GC2 alla cella GH38 ci sono altri numeri (così formati: ogni riga ha 6 numeri).

Cosa deve succedere:

Ogni numero che si trova nella colonna A1:A12, deve rilevare in ogni riga dalla cella GC2 alla cella GH38 il suo eguale, quando una di queste righe raggiunge il minimo di 3 numeri uguali deve l'intera riga in oggetto comparire nella riga 12, dalla cella AF12 - AG12 - AH12 e così via, spero che la spiegazione sia buona, un grazie anticipato
di Vecchio Frac data: 21/03/2013 15:50:13
Preferirei un esempio concreto...
Io ho capito che:
- devi considerare ogni numero in colonna A, verificare che tre di essi compaiano in una riga da GC2 a GH2 e così via da GC38 a GH38; se sì: si copia la riga dove compare tale terna da AF12-AG12-AH12 (e poi sarà AF13-AG13-AH13 etc. per ogni terna trovata)

?
di Attilio data: 21/03/2013 20:32:16
Ciao, Vecio, eehehehe, non proprio è così, ti mando un file di esempio, e grazie mille

di HarryBosch data: 21/03/2013 21:04:39
Ciao ragazzi

Prova la routine qua sotto:
- controllo ogni riga del range [gc2:gh38]
- per ogni riga conto i valori che sono presenti nel range [a1:a12]
- se la somma di questi valori + uguale o maggiore a 3, riporto l'intera riga in [af12].
- uscendo quindi dal ciclo, perché mi sembra di aver capito che ti interessa soltanto la prima riga con tale criterio...

Sub cerca_riga()
    Dim rng As Range, riga As Range
    Dim i As Integer, c As Integer

    Set rng = [gc2:gh38]
    For Each riga In rng.Rows
        For i = 1 To 12
            c = c + WorksheetFunction.CountIf(riga, Cells(i, 1))
        Next
        If c >= 3 Then riga.Copy [af12]: Exit Sub
        c = 0
    Next
End Sub

di Attilio data: 21/03/2013 21:48:30
ho fatto delle prove, ma non funziona come dovrebbe, nel senso, da come ho visto non prende la riga che ha raggiunto per prima la somma dei 3 numeri, ma li sceglie, come non so, invece, deve prendere in considerazione tutte le righe e la riga che per prima raggiunge i 3 numeri deve essere selezionata interamente e trasferita in AF12....ecc., poi se è possibile la cosa dovrebbe funzionare in automatico, senza il controllo di un pulsante, al riempimento della cella A12. scusa se non mi sono spiegato bene
di HarryBosch data: 21/03/2013 22:11:57
A mio avviso funziona correttamente, almeno se ho capito bene.
I 12 valori da A1 a A12 vengono controllati su ogni riga dell'intervallo [gc2:gh38] .
La prima riga che ne contiene almeno 3 viene riportata (i sei valori presenti) a partire dalla cella af12

Per attivare la macro dopo il riempimento della cella A12, devi utilizzare l'evento Change, da inserire nel modulo del foglio con i dati (vedi sotto).

Ti ri-allego il file con le macro inserite.
Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, [A12]) Is Nothing Then Exit Sub 'richiamo la macro di prima cerca_riga End Sub
di Attilio data: 21/03/2013 23:05:28
Ok, adesso funziona in automatico, ma se tu noti bene spesso da numeri doppi e numeri doppi nel mio Range (GC2:GH38) non ci sono numeri duplicati e quindi ne scrive 5 numeri invece di 6
di Attilio data: 22/03/2013 07:53:15
Scusami, forse ho capito dove è l'errore, non ho detto che i numeri oltre ad essere cambiati interamente nella colonna A1:A12, ma può essere cambiato solo un numero, e la cosa funziona benissimo se riscrivi tutti i numeri, ma se modifico un qualsiasi solo numero, va tutto in malora. pensi anche tu che possa essere questo il problema?
di HarryBosch data: 22/03/2013 19:02:13
non credo sia quello il problema.
Tagliamo la testa al toro: riallega un file con dati fittizi, dove il risultato che dovresti attenderti non torna.
Così vedo se inquadro l'inghippo :)
di Attilio data: 23/03/2013 09:16:06
Ti mando il file che hai fatto tu con l'esempio

di HarryBosch data: 23/03/2013 10:36:01
Ho visto il file. Due cose:

- intanto hai tolto il segno ">": If c >= 3 Then
che invece serve altrimenti verrà restituita soltanto la prima riga che contiene 3 valori, e non la prima che ne contiene ALMENO tre

- la prima colonna di ricerca contiene una formula: pertanto viene copiata la formula, che portata su altra riga, produrrà un risultato diverso (visto che cambiano i riferimenti)

Ho modificato la parte in cui vengono copiati i dati, facendo copiare soltanto i valori.
Vedi ora

Sub cerca_riga()
    Dim rng As Range, riga As Range
    Dim i As Integer, c As Integer
    Set rng = [n2:s38]
    For Each riga In rng.Rows

        For i = 1 To 12
            c = c + WorksheetFunction.CountIf(riga, Cells(i, 1))
        Next

        If c >= 3 Then
            riga.Copy
            [d19].PasteSpecial xlValues
            Exit Sub
        End If

        c = 0
    Next
    MsgBox "Nessuna riga con 3 valori"
End Sub

di Attilio data: 23/03/2013 14:22:51
Si hai ragione della tolta del segno maggiore, ma avevo solo fatto delle prove per vedere se riuscivo a far qualcosa io, adesso funziona, però c'è ancora una cosa che non va, se nel listato aggiungo questa cosa funziona?

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [A12]) Is Nothing Then Exit Sub
    'richiamo la macro di prima
    cerca_riga
End Sub

per non far apparire i numeri quando cancello la cella A12, la modificassi così va bene?

Private Sub Worksheet_Change(ByVal Target As Range)
if [A12]="" then Range("AF12", "AK12").Clear.Contents
end if
    If Intersect(Target, [A12]) Is Nothing Then Exit Sub
    'richiamo la macro di prima
    cerca_riga
End Sub

di Attilio (utente non iscritto) data: 27/03/2013 14:49:33
Abbandonato?
di Vecchio Frac data: 27/03/2013 15:40:04
Del resto, è Pasqua ^_^
"Mio Dio, mio Dio, perchè mi hai abbandonato"?

LOL, giusto per stemperare.
So che Harry è incasinato in questo periodo.
Vedrò di riprendere io il thread per darti una mano.
di Attilio (utente non iscritto) data: 27/03/2013 16:42:32
La mia non era una lamentela, ma una violenta rivoluzione, ihihihihihi, grazie sei sempre gentilissimo, cmq vedi se puoi aiutarmi tu, io intanto aspetto tra gli alberi di OLIVO

di Raffaele_53 (utente non iscritto) data: 27/03/2013 21:22:46
Da provare

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A12")) Is Nothing Then
    If Range("A12") = "" Then
    Range("AF12:AK12").ClearContents
Else
        cerca_riga
    End If
    End If
End Sub

di Attilio (utente non iscritto) data: 27/03/2013 21:50:12
Grazieeeeeeeee, sei grande Raffaele, funziona benissimo, ancora grazie
di HarryBosch data: 29/03/2013 17:16:55
O.T.
Attilio scusami, ma questi giorni diverse vicissitudini mi hanno impedito di seguire il Forum.

Ringrazio particolarmente VecchioFrac e Raffaele che hanno aiutato il nostro amico ^_^
di Attilio (utente non iscritto) data: 29/03/2013 17:19:50
Tranquillo, l'importante e che spero ti vada tutto bene, auguri per la Pasqua, se mi cerchi sono tra gli olivi, aspetto la crocifissione!!!

Vuoi Approfondire?