Condividi:        

trovare numeri uguali in range

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

trovare numeri uguali in range

Postdi miko » 01/12/19 07:13

Buongiorno e buona domenica,
vedendo la velocità della macro realizzata nel topic numeri consecutivi per riga
ho riesumato un vecchio progetto abbandonato perchè le macro realizzate e/o adattate
non funzionavano oppure i tempi di elaborazione erano elevati, anche giorni interi,
per confrontare circa 10.000 righe.
si tratta di confrontare ciascuna riga con tutte quelle successive alla ricerca dei numeri uguali,
e di riportare il risultato del confronto in altre celle.
il risultato in questo caso non è la quantità di numeri uguali ma il numero di volte in cui si hanno
numeri singoli, coppie, terzine, ... sestine oppure nessun numero uguale.

Immagine

confrontiamo la prima riga, riga 10, range (H10:M10), con tutte le righe successive;
in riga 11 non ci sono numeri uguali, riporto sotto 0N, in X10 e X11 il valore 1, ad indicare che 1 volta
non si hanno numeri in comune.
passiamo alla riga successiva, e confrontiamo sempre la riga 10 con la riga 12, e qui si hanno 4 numeri uguali,
riporto sotto 4N in T10 e T12 il valore 1, ad indicare che 1 volta si hanno 4 numeri uguali, una quartina.
in pratica è come avere 2 range uguali e confronto ogni riga del range1 con ciascuna riga del range2,
escludendo dal range2 la riga uguale.
confrontando la riga 10 con la 13 trovo 1 numero uguale e sotto 1N, in W10 e W13, scrivo 1.
continuando il confronto tra riga 10 e successive, in riga 14, e poi in riga 17, trovo 6 numeri uguali, range uguale,
in colonna 6N in R10 scrivo 1 e poi 2, mentre in R14 ed R17 inserisco la stringa = RIGA 10.
terminato il confronto tra riga 10 e successive, passo a confrontare riga 11 con tutte le successive
fino all'ultima riga, aggiungendo ai valori già presenti nel range R-X il risultato di questo ulteriore confronto.
così procedo per le altre righe del range N-M.
faccio notare, può essere utile per velocizzare il confronto, che in ciascuna riga del range H-M,
i numeri sono unici e disposti in ordine crescente.
nel caso particolare di 6 numeri uguali, quando nel confronto si giunge ad esaminare una riga del tipo 14 o 17 con le successive, è inutile eseguire il confronto essendo uguali a riga 10, troverei gli stessi valori di riga 10 e falserebbe il risultato finale, per cui possiamo passare direttamente ad esaminare la riga successiva cioè la 15 o la 18 rispettivamente.
allego un file con poche righe identico a quello in figura.
http://www.filedropper.com/numeriuguali
date le mie conoscenze limitate di excel è possibile che con qualche altro criterio o modificando la macro del topic citato
si possa raggiungere il risultato in tempi accettabili.
saluti, grazie
windows 10 - office 2013
miko
Utente Senior
 
Post: 521
Iscritto il: 29/12/09 10:44

Sponsor
 

Re: trovare numeri uguali in range

Postdi Anthony47 » 01/12/19 22:26

Pero' nella colonne delle Sestine o ci metti il contatore o ci metti la riga che si accoppia; e se vuoi la riga accoppiata, vuoi la prima o l'ultima?
Immaginando che preferisci averci il contatore, la cosa piu' veloce che mi e' venuta e' questa macro:
Codice: Seleziona tutto
Sub MiKoK()
Dim WArr, oArr(), Arr90(1 To 90), lCnt As Long
Dim iRan As String, I As Long, J As Long, K As Long
Dim myTim As Single, UBW As Long
'
iRan = "H10"            '<<< L'inizio della tabella Dati
'
myTim = Timer
WArr = Range(Range(iRan), Range(iRan).End(xlDown)).Resize(, 6).Value
UBW = UBound(WArr)
ReDim oArr(1 To UBW, 0 To 6)
For I = 1 To UBW - 1
    Erase Arr90
    For J = 1 To 6
        Arr90(WArr(I, J)) = WArr(I, J)
[code][/code]    Next J
    For J = I + 1 To UBW
        lCnt = 0
        For K = 1 To 6
            If Arr90(WArr(J, K)) <> 0 Then lCnt = lCnt + 1
        Next K
        oArr(I, 6 - lCnt) = oArr(I, 6 - lCnt) + 1
        oArr(J, 6 - lCnt) = oArr(J, 6 - lCnt) + 1
    Next J
Next I
Range(iRan).Offset(0, 10).Resize(30000, 7).ClearContents
Range(iRan).Offset(0, 10).Resize(UBound(oArr), 7).Value = oArr
MsgBox ("Completato, sec: " & Format(Timer - myTim, "0.00"))
End Sub

Pero' il tempo di esecuzione aumenta in maniera quadratica all'aumentare delle righe (raddoppiano le righe, il tempo quadruplica), e per 10mila righe impieghera' molti secondi.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19221
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: trovare numeri uguali in range

Postdi miko » 06/12/19 06:57

Buongiorno,
ho applicato la tua macro, che va bene con il contatore, ad un range di 40 righe;
i tempi sono dell'ordine di 0,025391 secondi, eccezionale.
con le mie realizzazioni con lo stesso range, excel impiegava dai 6 ai 7 secondi.
anche il criterio di calcolo che hai adottato semplice nell'idea ma efficace e risolutivo.
peccato che ti sei fermato "...la cosa piu' veloce che mi e' venuta.." se realizzavi quella superveloce
avrei la macro a secondi zero. ;)
grazie.
ho voluto modificare ed applicare il codice a 2 casi che possono presentarsi, ma i
tentativi sono falliti.

caso 1
trovare i numeri uguali di ciascuna riga del range2 di foglio 2, confrontando con ciascuna e tutte le
righe del range1 di foglio 1, prendi esempio della figura ad inizio post immaginando 2 fogli.
in questo caso la matrice dei risultati, oArr, dovrebbe contenere una sola linea relativa al range2
e riportare i risultati a fianco di ciascuna riga del range2 di foglio 2.
in questo caso ho ipotizzato che i 2 range hanno differente numero di righe ma uguale numero di colonne.

caso 2
come nel caso 1, ma ora i 2 range hanno differente numero di righe e differente numero di colonne
ad esempio il range2 è costituito da 15 colonne.

nel tentativo che ho fatto mi sono bloccato con gli indici della matrice Arr90 ed ho introdotto un'altra matrice
simile, in una inserisco il range1 nell'altra il range2, ma non riesco a risolvere il problema e mi sembra solo
un confronto tra item di matrici.
saluti grazie
windows 10 - office 2013
miko
Utente Senior
 
Post: 521
Iscritto il: 29/12/09 10:44

Re: trovare numeri uguali in range

Postdi miko » 13/12/19 13:08

Salve,
ho provato a modificare il codice di Anthony per applicarla al caso 1 che descrivevo in precedenza,
ma ho problemi con gli ubound delle matrici poichè al variare degli indici dei cicli for,
si supera l'ubound,per via della differenza di righe, ed ho messaggio "indice non incluso nell'intervallo."
anche usando 2 matrici ottengo lo stesso risultato.
dopo varie modifiche e tentativi falliti ho rinunciato.
peccato, il criterio adottato è interessante.
tuttavia prendendo spunto dal suo codice ho provato col metodo FIND, con 2 matrici contenenti ciascuna
1 range e confrontando gli item, confrontando i valori cella per cella, ma siamo su tempi di calcolo elevati.
sono approdato alla seguente macro che se pur non ben strutturata, risolve il caso 1, ma anche con questo
codice i tempi di elaborazione sono alti, per 40 righe impiega 2,5 secondi;
tenuto conto di quanto dichiarato da Anthony
"...tempo di esecuzione aumenta in maniera quadratica all'aumentare delle righe..."
se il calcolo del tempo è valido anche per questo codice allora ci vorrà 1 giorno e forse di più.
di seguito quello che sono riuscito a realizzare

Codice: Seleziona tutto
Sub TROVA()

Dim Rng1 As Range

Dim RisArray(), myTim As Single

Dim First2, Last2, R2, Conta As Integer

   On Error Resume Next

   myTim = Timer

   Application.ScreenUpdating = False

   Application.Calculation = xlManual
   
   Application.EnableEvents = False

  First1 = 10
 
  Last1 = Worksheets("Foglio1").Range("F" & Rows.Count).End(xlUp).Row
   
  First2 = 10
 
  Last2 = Worksheets("Foglio2").Range("C" & Rows.Count).End(xlUp).Row
 
  Worksheets("Foglio2").Range("C" & First2 & ":H" & Last2) _
                .Offset(0, 8).Resize(Last2 - 9, 7).ClearContents
               
  For R2 = First2 To Last2
   
      ReDim RisArray(R2 To Last2, 0 To 6)
 
  For N1 = First1 To Last1

     With Worksheets("Foglio1")
     
     Set Rng1 = .Range(.Cells(N1, 8), .Cells(N1, 13))
     
     End With
     
     Col = 3

      For Each Val1 In Rng1
       
        For Col2 = Col To 8
         
           Val2 = Worksheets("Foglio2").Cells(R2, Col2).Value

             If Val2 = Val1 Then

               Conta = Conta + 1
             
              Col = Col + 1

              GoTo NEXTVal1

            End If

        Next Col2

NEXTVal1:

      Next Val1
     
      RisArray(R2, 6 - Conta) = RisArray(R2, 6 - Conta) + 1

      Conta = 0
     
      Set Rng1 = Nothing
 
   Next N1
   
   Worksheets("Foglio2").Range("C" & R2) _
               .Offset(0, 8).Resize(1, 7).Value = RisArray
   
Next R2

    Application.EnableEvents = True
   
    Application.Calculation = xlCalculationAutomatic
   
    Application.ScreenUpdating = True
 
   MsgBox ("Completato in " & Format(Timer - myTim, "0.######") & " " & "sec")

End Sub

ora ho esaurito le mie conoscenze di excel ed anche il criterio ci calcolo si riduce sempre ad un confronto
tra celle o item, e non riesco a immaginare un modo diverso per affrontare il problema.
saluti, grazie
windows 10 - office 2013
miko
Utente Senior
 
Post: 521
Iscritto il: 29/12/09 10:44

Re: trovare numeri uguali in range

Postdi Anthony47 » 18/12/19 01:20

Come ho scritto ad altri, "esigenze di stagione" mi lasciano poco tempo; ma non mi sono ancora dimenticato di te...
Avatar utente
Anthony47
Moderatore
 
Post: 19221
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: trovare numeri uguali in range

Postdi Anthony47 » 21/01/20 20:44

Confesso che le "esigenze di stagione" piu' qualche imprevisto successivo mi avevano fatto dimenticare il quesito.
Mi pare che la domanda sia:
-dato un elencone di estrazioni (tantissime righe * 6 colonne)
-dato un secondo elenco analogo (N righe * 6 colonne)
-si vuole calcolare, per ognuna delle N righe del secondo elenco quante volte quei numeri compaiono 6 volte, 5 volte, ... 1 volta, zero volte nell'elencone delle estrazioni

Utilizzando quanto gia' fatto in un quesito precedente, il tutto si dovrebbe tradurre in questa macro:
Codice: Seleziona tutto
Sub MiKoK22()
Dim WArrE, WArrR, oArr(), Arr90(1 To 90), lCnt As Long
Dim iRan As String, I As Long, J As Long, K As Long
Dim myTim As Single, UBWE As Long, lArr
Dim ShEl As Worksheet, ShRef As Worksheet

iRan = "H10"                            '<<< Inizio tabelle (sia Elenco ed Elencone)
Set ShEl = Worksheets("Foglio2")        '<<< Foglio con Elenco righe da confrontare
Set ShRef = Worksheets("Foglio1")       '<<< Foglio con Elencone verso cui confrontare

WArrE = ShEl.Range(ShEl.Range(iRan), ShEl.Range(iRan).End(xlDown)).Resize(, 6).Value
WArrR = ShRef.Range(ShRef.Range(iRan), ShRef.Range(iRan).End(xlDown)).Resize(, 6).Value
myTim = Timer
UBWE = UBound(WArrE)
ReDim oArr(1 To UBWE, 0 To 6)
For I = 1 To UBWE
    Erase Arr90
    For J = 1 To 6
        Arr90(WArrE(I, J)) = WArrE(I, J)
    Next J
    For J = 1 To UBound(WArrR)
        lCnt = 0
        For K = 1 To 6
            If Arr90(WArrR(J, K)) <> 0 Then lCnt = lCnt + 1
        Next K
        oArr(I, 6 - lCnt) = oArr(I, 6 - lCnt) + 1
    Next J
    DoEvents
Next I
ShEl.Range(iRan).Offset(0, 10).Resize(30000, 7).ClearContents
ShEl.Range(iRan).Offset(0, 10).Resize(UBound(oArr), 7).Value = oArr
MsgBox ("Completato, sec: " & Format(Timer - myTim, "0.00"))
End Sub

Le righe marcate <<< sono da compilare come da commento

I risultati vengono scritti accanto a "Elenco"

Se il quesito era un altro, allora indirizzami nuovammente; se il quesito e' giusto ma i risultati che calcolo sono errati allora dovresti ricondividere un file di esempio con un Elencone e u Elenco su cui riporti sia l'esito della macro che i risultati che invece ti attendevi

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19221
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: trovare numeri uguali in range

Postdi miko » 08/12/20 21:44

Buonasera
dopo mesi di inattività riprendo il discorso interrotto e rispondo al tuo ultimo post.
l'ultima macro, la "Sub MiKoK22", soddisfa pienamente il quesito posto e funziona egregiamente, grazie.
ho provato a modificare la macro citata per realizzare quanto segue:

Worksheets("Foglio2") '<<< Foglio con Elenco righe da confrontare
elenco con (N righe * 15 colonne)

Worksheets("Foglio1") '<<< Foglio con Elencone verso cui confrontare
elencone con (tantissime righe * 6 colonne)

si vuole calcolare, per ognuna delle N righe di elenco quante volte quei numeri compaiono 6 volte, 5 volte, ... 1 volta, zero volte nell'elencone

I risultati vengono scritti accanto a "Elenco" di foglio 2

quello che cambia, rispetto all'ultima macro è il numero di colonne tra elenco ed elencone

i miei tentativi inutili mi danno sempre errore per via delle dimensioni delle matrici.
cosa si deve modificare od aggiungere alla macro per ottenere il risultato desiderato?
ciao grazie
windows 10 - office 2013
miko
Utente Senior
 
Post: 521
Iscritto il: 29/12/09 10:44

Re: trovare numeri uguali in range

Postdi Anthony47 » 09/12/20 00:14

Mah, a spanne mi pare che le modifiche siano quelle in grassetto + Blu in questo specchietto:

WArrE = ShEl.Range(ShEl.Range(iRan), ShEl.Range(iRan).End(xlDown)).Resize(, 6).Value
WArrR = ShRef.Range(ShRef.Range(iRan), ShRef.Range(iRan).End(xlDown)).Resize(, 6).Value
myTim = Timer
UBWE = UBound(WArrE)
ReDim oArr(1 To UBWE, 0 To 6)
For I = 1 To UBWE
Erase Arr90
For J = 1 To Ubound(WArrE,2)
Arr90(WArrE(I, J)) = WArrE(I, J)
Next J
For J = 1 To UBound(WArrR)
lCnt = 0
For K = 1 To UBound(WArrR,2)
If Arr90(WArrR(J, K)) <> 0 Then lCnt = lCnt + 1
Next K
oArr(I, 6 - lCnt) = oArr(I, 6 - lCnt) + 1
Next J
DoEvents
Next I

Se così facendo "stranamente" non funzionasse allora allega un file di esempio e vedremo meglio

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19221
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "trovare numeri uguali in range":


Chi c’è in linea

Visitano il forum: Nessuno e 46 ospiti