Allineare celle con dati uguali in excel 2013

[nagato]

Salve a tutti, non riesco a trovare (anche negli altri post) una soluzione efficace a qeusto problema:

ho quattro colonne con i seguenti dati



ho necessità di far comparire nella colonna B (che rimane inizialmente vuota) i valori corrispondenti della colonna D dei colori in modo da avere poi le voci ordinate con il loro colore corretto nella colonna AeB.
Il problema è che le righe sono tante (circa 20.000) e le macro che ho trovato in giro per la rete si bloccano, funzionano solo con un certo numero di righe.
Qualcuno può aiutarmi?

[ricky53]

Ciao,
allega il codice con il quale hai fatto le prove.

Comunque se NON hai molte colonne e righe con formule potresti provare con la funzione "CERCA.VERT"

[nagato]

Questo e' l'ultimo provato (non mio sia chiaro), che funzionava benissimo, ma era su più colonne, riservava le colonne B-C-D per i risultati, confrontando le colonne A e E.
Andava anche benissimo per qualche decina di righe, solo che oltre un certo numero di righe non ce la fà e si blocca excel.

Codice: Seleziona tutto

Public Sub allinea()

    Dim sh As Worksheet
    Dim lRigaA As Long
    Dim lRigaE As Long
    Dim lngA As Long
    Dim lngE As Long

    Set sh = ThisWorkbook.Worksheets("mese")

    With sh
        lRigaA = .Range("A" & .Rows.Count).End(xlUp).Row
        lRigaE = .Range("E" & .Rows.Count).End(xlUp).Row
        For lngE = 1 To lRigaE
            For lngA = 1 To lRigaA
                If Left(.Range("E" & lngE).Value, 13) = _
                    Left(.Range("A" & lngA).Value, 13) Then
                    .Range("B" & lngA).Value = .Range("E" & lngE).Value
                    .Range("C" & lngA).Value = .Range("F" & lngE).Value
                    .Range("D" & lngA).Value = .Range("G" & lngE).Value
                    Exit For
                End If
            Next
        Next
    End With
   
    Set sh = Nothing

End Sub

[ricky53]

Ciao,
lo guardo e ... ci risentiamo.

In attesa prova con la funzione "CERCA.VERT"

[nagato]

Grazie

[ricky53]

Ciao,
prova questa variante che con 30.000 righe ha impiegato sul mio Pc (di media potenza) 12 secondi: per me sono troppi e si può migliorare lavorando con le "ARRAY" ma prima vediamo i tuoi tempi.

Codice: Seleziona tutto

Public Sub allinea_1()
    Dim SH As Worksheet, lRigaA As Long, lRigaC As Long, lngA As Long, lngC As Long, Inizio As Double

    Inizio = Timer
    Set SH = ThisWorkbook.Worksheets("mese")
    With SH
        lRigaA = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("B2:B" & lRigaA).ClearContents
        lRigaC = .Range("C" & .Rows.Count).End(xlUp).Row
        For lngC = 2 To lRigaC
            For lngA = 2 To lRigaA
                If Left(.Range("C" & lngC).Value, 13) = Left(.Range("A" & lngA).Value, 13) Then
                    .Range("B" & lngA).Value = .Range("D" & lngC).Value
                    Exit For
                End If
            Next
        Next
    End With
    Set SH = Nothing
    MsgBox "Elaborazione effettuata in  '" & Format(Timer - Inizio, "0.000") & "'  secondi"
End Sub


ATTENZIONE: Il codice che ho modificato utilizza le colonne del TUO ESEMPIO e parte dalla riga "2"

[ricky53]

Ciao,
dopo la versione "BASE" dell'intervento precedente ...

tanto per gradire ecco la versione "AVANZATA" (molto più veloce: solo 0,250 sec per 30.000 righe)

Codice: Seleziona tutto

Option Compare Text
Option Base 1
Option Explicit

Public Sub Allinea_2()
    Dim SH As Worksheet, lRigaA As Long, lRigaC As Long, lngA As Long, lngC As Long, Inizio As Double
    Dim Matr1, Matr2
   
    Inizio = Timer
    Set SH = ThisWorkbook.Worksheets("mese")
    With SH
        lRigaA = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("B2:B" & lRigaA).ClearContents
        lRigaC = .Range("C" & .Rows.Count).End(xlUp).Row
        Matr1 = .Range("A2:B" & lRigaA)
        Matr2 = .Range("C2:D" & lRigaC)
       
        For lngC = 1 To lRigaC - 1
            For lngA = 1 To lRigaA - 1
                If Matr2(lngC, 1) = Matr1(lngA, 1) Then
                    Matr1(lngA, 2) = Matr2(lngC, 2)
                    Exit For
                End If
            Next
        Next
        .Range("A2:B" & lRigaA) = Matr1
    End With
       
    Set SH = Nothing
    MsgBox "Elaborazione effettuata in  '" & Format(Timer - Inizio, "0.000") & "'  secondi"
End Sub

Provala e ... sono QUI

[nagato]

L'ho provata su qualche riga e va che è una meraviglia, il grosso pero' ce l'ho in ufficio.
Sono impaziente di provarla lunedi', quando torno al lavoro.
Posso solo dirti un immenso grazie per la tua disponibilità e competenza!
Sei un grande!

[ricky53]

Ciao,
troppi complimenti mi ... confondono.

Aspettiamo lunedì per sapere che tempi di elaborazione ottieni con i tuoi dati reali.

Buon 25 APRILE

[nagato]

Allora, con i dati reali ho ottenuto 77 secondi (excel non rispondeva ma perchè stava lavorando) per 17000 righe.
Sono dei codici seriali a 12 cifre, forse per questo ci mette di piu'?

[ricky53]

Ciao,
il tempo di 77 sec. l'hai ottenuto con la versione che utilizza le matrici?

[Anthony47]

Penso che sia cruciale la lunghezza dell' elenco in col C:D.
Questa versione potrebbe essere leggermente piu' veloce, perche' sfrutta anche un Dictionary:

Codice: Seleziona tutto

Sub allinea3()
Dim ArrA, ArrB(), ArrCD, I As Long, aaa, LastA As Long, LastC As Long, myTim As Single
Dim myD   'my Dictionary
myTim = Timer
Set myD = CreateObject("Scripting.Dictionary") 'Modalita' Late Binding
myD.RemoveAll   ' Clear del dictionary
LastA = Cells(Rows.Count, 1).End(xlUp).Row
LastC = Cells(Rows.Count, 3).End(xlUp).Row
'
ArrA = Range("A2").Resize(LastA - 1, 1).Value
ArrCD = Range("C2").Resize(LastC - 1, 2).Value
ReDim ArrB(LBound(ArrA, 1) To UBound(ArrA, 1))
Range("B2").Resize(LastA - 1, 1).ClearContents
'
For I = LBound(ArrCD, 1) To UBound(ArrCD, 1)
    myD.Add ArrCD(I, 1), ArrCD(I, 2)
Next I
'
For I = LBound(ArrA, 1) To UBound(ArrA, 1)
    ArrB(I) = myD(ArrA(I, 1))
Next I
Range("B2").Resize(LastA - 1, 1).Value = Application.WorksheetFunction.Transpose(ArrB)
MsgBox ("Completato in (sec): " & Format(Timer - myTim, "0.00"))
End Sub

Ciao a tutti.

[ricky53]

Ciao,
ottima la soluzione di ANTHONY !!!
COMPLIMENTI.

Con 100 righe in colonna "A" e 30.000 nell'intervallo "C-D"
il tempo impiegato con il codice di Anthony è di 0,22 sec.
con la mia versione siamo a 1,62 sec.
E' un tempo alto confrontato con quello di Anthony; il mio è più lento di oltre "7" volte.

La lentezza aumenta esponenzialmente all'aumentare delle righe in colonna "A"!

Infatti con 1.000 righe in colonna "A" e 30.000 nell'intervallo "C-D"
il tempo impiegato con il codice di Anthony è di 0,24 sec.
con la mia versione siamo a 15,53 sec.
Qui è più lento di oltre "64" volte.



UTILIZZA ASSOLUTAMENTE LA VERSIONE DI ANTHONY !!!