Ordinare colonne sulla stessa riga se stesso contenuto

[Ricky0185]

Buongiorno, devo ordinare DUE gruppi di colonne di lunghezza diversa, ma ambedue molto lunghe, sullo stesso foglio facendo in modo che sulla stessa riga ci siano i valori che in colonna A sono uguali a quelli della colonna G, ma se non corrispondenti, nel GRUPPO ove il valore della colonna A non corrisponde a quello della colonna G la riga resti bianca. Altrettanto in colonna G, riga bianca ove non c’è corrispondenza con colonna A.

Grazie
R
PS Dall'amico Alfredo stessa richiesta, ma la soluzione è rimasta nella penna, anzi nelle dita, di Terio

[Anthony47]

Sono due mesi che aspettavo di vedere come pensavi di allineare i dati, cosa che andrebbe fatta già mentre importi i csv...

Prova questo codice, che lavora sul layout che hai pubblicato:

Codice: Seleziona tutto

Sub Allinea()
Dim bsArr, bcArr(), aInd
Dim LaR As Long, Gr1W As Long, Gr2W As Long
Dim I As Long, myMatch, JJ As Long, DummInd As Long, ExtraL As Long
'
Gr1W = Range("A1").CurrentRegion.Columns.Count
Gr2W = Cells(1, Gr1W + 2).CurrentRegion.Columns.Count
'
'End gruppo B:
LaR = Cells(1, Gr1W + 2).Resize(10000, Gr2W).Find(What:="*", After:=Cells(1, Gr1W + 2), _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlPrevious).Row
'
aInd = Application.WorksheetFunction.Index(Range("A1").CurrentRegion, 0, 2)     'Indice gruppo A
bsArr = Cells(1, Gr1W + 2).Resize(LaR, Gr2W).Value                              'Gruppo B
ReDim bcArr(1 To UBound(bsArr) * 2, 1 To UBound(bsArr, 2))                      'Gruppo B pulito
DummInd = 765765000
For I = 1 To UBound(aInd)
'fill righe vuote
    If Len(aInd(I, 1)) = 0 Then
        aInd(I, 1) = DummInd
        DummInd = DummInd + 1
    End If
Next I
DummInd = 765765000
ExtraL = 0
For I = 1 To UBound(bsArr)
'Cerca e allinea:
    If Len(bsArr(I, 1)) > 0 Then                                    'Pieno /Vuoto
        If I = 1 Then                                               'Copia Headers
            myMatch = 1
        Else
            myMatch = Application.Match(bsArr(I, 1), aInd, False)       'Posiz in AIND
        End If
        If IsError(myMatch) Then                                    'Manca, cerca DummInd
            myMatch = Application.Match(DummInd, aInd, False)       'Posiz con DummInd
            If IsError(myMatch) Then                                'Manca, aggiungi
                ExtraL = ExtraL + 1
                myMatch = UBound(aInd) + ExtraL
                For JJ = 1 To UBound(bsArr, 2)                        'Copia in posizione
                    bcArr(myMatch, JJ) = bsArr(I, JJ)
                Next JJ
            Else                                                    'Trovato con DummInd
                For JJ = 1 To UBound(bsArr, 2)                        'Copia in posizione
                    bcArr(myMatch, JJ) = bsArr(I, JJ)
                Next JJ
                DummInd = DummInd + 1
            End If
        Else                                                        'Trovato in AInd
            For JJ = 1 To UBound(bsArr, 2)                            'Copia in posizione
                bcArr(myMatch, JJ) = bsArr(I, JJ)
            Next JJ
        End If
    End If
Next I
'Riscrive Area B:
Cells(1, Gr1W + 2).Resize(UBound(bcArr), UBound(bcArr, 2)).Value = bcArr
End Sub

[Ricky0185]

Ciao, intanto ti ringrazio per la tempestività nel rispondermi. Purtroppo la macro ha qualche problema non di funzionamento (nessuna interruzione) ma di risultato. Ti spiego il procedimento di elaborazione del file, anzi dei 2 file.
La macro d’importazione mette i due file in colonna A, uno sotto l’altro, seguono istruzioni per allinearli sulla riga 1 lasciando fra i DUE una colonna vuota. Nel file “con macro decapitate” seguivano le istruzioni per scegliere i due listati e quindi ordinare le righe secondo corrispondenza dei contenuti di ciascuna. Poi via via fino ad arrivare alle freccette colorate.
Il file, prima di perdere tutte le macro, era finito e funzionante al netto degli indirizzi di quelle celle che ovviamente col passar del tempo sono variabili. Lo vedi nel file trasmesso alle 20,41 di “Come evidenziare aree separate di un foglio”, che ho trasmesso quando mi hai chiesto un file dove dopo il salvataggio erano sparite le macro.
Purtroppo l’unica macro (non tua), che ordinava le righe non riesco a ritrovarla, tutte le altre (eccetto l’importazione) sono tratte dalle mie richieste su pc-facile. Anche quelle che, dopo l’ordinamento, portano fino alle freccette colorate, che inserirò in coda all'ordinamento.
La tua macro la trovi ultima nel VB del file allegato. Non ho messo quelle che dopo l'ordinamento portano alle freccette e tutto il resto.
Ti saluto
R

[Anthony47]

Nel file che hai pubblicato oggi la "chiave" era in colonna B; nel file che pubblichi stasera mi sembra che sia la colonna A.
Quale dei due e' corretta?

[Ricky0185]

QUELLO che ti ho trasmesso a riprova della perdita delle macro

[Anthony47]

Questa e' la versione compatibile col nuovo layout dati:

Codice: Seleziona tutto

Sub Allinea()
Dim bsArr, bcArr(), aInd
Dim LaR As Long, Gr1W As Long, Gr2W As Long
Dim I As Long, myMatch, JJ As Long, DummInd As Long, ExtraL As Long
'
'End Gruppo A:
LaR = Cells(Rows.Count, 1).End(xlUp).Row
aInd = Range("A1").Resize(LaR, 1).Value                             'Indice gruppo A

Gr1W = Range("A1").CurrentRegion.Columns.Count
Gr2W = Cells(1, Gr1W + 2).CurrentRegion.Columns.Count
'
'End gruppo B:
LaR = Cells(1, Gr1W + 2).Resize(10000, Gr2W).Find(What:="*", After:=Cells(1, Gr1W + 2), _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlPrevious).Row
'
bsArr = Cells(1, Gr1W + 2).Resize(LaR, Gr2W).Value                              'Gruppo B
ReDim bcArr(1 To UBound(bsArr) * 2, 1 To UBound(bsArr, 2))                      'Gruppo B pulito
DummInd = 765765000
For I = 1 To UBound(aInd)
'fill righe vuote
    If Len(aInd(I, 1)) = 0 Then
        aInd(I, 1) = DummInd
        DummInd = DummInd + 1
    End If
Next I
DummInd = 765765000
ExtraL = 0
For I = 1 To UBound(bsArr)
'Cerca e allinea:
    If Len(bsArr(I, 1)) > 0 Then                                    'Pieno /Vuoto
        If I < 3 Then                                              'Copia Headers
            myMatch = I
        Else
            myMatch = Application.Match(bsArr(I, 1), aInd, False)       'Posiz in AIND
        End If
        If IsError(myMatch) Then                                    'Manca, cerca DummInd
            myMatch = Application.Match(DummInd, aInd, False)       'Posiz con DummInd
            If IsError(myMatch) Then                                'Manca, aggiungi
                ExtraL = ExtraL + 1
                myMatch = UBound(aInd) + ExtraL
                For JJ = 1 To UBound(bsArr, 2)                        'Copia in posizione
                    bcArr(myMatch, JJ) = bsArr(I, JJ)
                Next JJ
            Else                                                    'Trovato con DummInd
                For JJ = 1 To UBound(bsArr, 2)                        'Copia in posizione
                    bcArr(myMatch, JJ) = bsArr(I, JJ)
                Next JJ
                DummInd = DummInd + 1
            End If
        Else                                                        'Trovato in AInd
            For JJ = 1 To UBound(bsArr, 2)                            'Copia in posizione
                bcArr(myMatch, JJ) = bsArr(I, JJ)
            Next JJ
        End If
    End If
Next I
'Riscrive Area B:
Cells(1, Gr1W + 2).Resize(UBound(bcArr), UBound(bcArr, 2)).Value = bcArr
End Sub


[Ricky0185]

Intanto ho scoperto perchè spariscono le macro nonostante il file venga salvato in .xlsm. La prima macro, quella che importa i csv, crea un foglio nuovo su cui riversa i due csv, in colonna A e uno di seguito all'altro. Ma le macro restano sul file d'apertura, cioè sul foglio bianco, sono i dati che vengono riversati sul foglio creato, così come per tutte le macro a seguire. Dall'immagine
si capisce meglio. Ovviamente si salva con il foglio dei dati aperto, ma che non contiene nessuna macro. Per mantenere tutti i dati presenti nel foglio così come le macro bisogna tornare al foglio bianco e salvarlo in .xlsm. Riaprendo il file compare il foglio bianco e basta scegliere sull'iconcina in basso il foglio con i dati per avere dati e foglio con tutte le macro. Ieri sera (anzi stamattina) ho fatto le ore piccole, ma con successo.
Vado a cena poi sbarlumo la nuova macro di Anthony.
Intanto buona serata.
R

[Ricky0185]

Bingo.
Buonasera, dopo due serate trascorse (con gioia della famiglia) a cercare la pagina web contenente la macro che ordina le righe secondo il loro contenuto, finalmente l’ho trovata. Per vederla in azione bisogna avviare la macro “Ordina Righe Corrispondenti” nel FILE allegato.
Per completare il file occorre avviare in questo ordine le macro “MacroTotali”, “Trascina Giù Totali” e “Freccette”. Poi applicando un filtro su Agente o SEDE ho proprio il raffronto che mi serve. Ma ho l’ultimo problema, il filtro non funziona se lascio la colonna di separazione, che devo eliminare prima di filtrare.
Applicando la tua macro e filtrando per un qualsiasi nome, mi lasciava in coda una sfilza di nomi, ovviamente quelli per cui non c’era corrispondenza fra le righe dei due gruppi e quindi inutilizzabili.
Ho lasciato nel VB le macro separate in ordine di lancio per verifiche varie, ma nel file finale le macro sono tutte riunite in una sola (comprendente anche quelle a finire) e lanciata con un iconcina nella barra di avvio veloce.
Ringraziandoti del tempo che hai dedicato al mio quesito e con la promessa di non disturbarti più, ti auguro un buon WE
R

[Anthony47]

Non ti seguo...
Avevi chiesto una cosa, ti ho proposto qualcosa in merito; perche' ora alleghi un file? Che cosa dovrei cercare nel file?

[Ricky0185]

Volevo solo renderti partecipe del fatto che con il ritrovamento della macro e principalmente con il tuo aiuto ho finalmente risolto la questione relativa ad un raffronto di dati fatto per due anni diversi.
Ti saluto
R

[Anthony47]

Malpensante quale sono credevo che volessi che mi auto-dimostrassi che qualcosa non funzionava...
Alla prossima?