Macro impossibile

Hai un problema con Excel?

Nuova discussione

Macro impossibile
di R.five (utente non iscritto) data: 18/06/2016 00:31:09
Buonasera ragazzi, ho un super problema, devo sistemare una mole di dati Excel infinita che prevede di usare sempre gli stessi comandi e mi chiedevo se si potesse rendere il tutto più veloce dato che sono sempre gli stessi passaggi da fare. In particolare volevo chiedere a voi, molto più esperti di me, se è possibile fare una cosa del genere considerando di partire dal primo foglio iniziale (foglio1) che riporta un insieme di dati composti in questo modo: ci sono 3 colonne che sono la descrizione (A,B,C) e poi dalla 4 colonna (D)in poi una serie di colonne che ogni presentano una serie di celle vuote e celle piene. Queste sono le operazioni che dovrei fare:
- fare una copia del primo foglio in un secondo foglio (figlio2)in modo che l'originale rimanga
- Successivamemente dovrei eliminare da foglio2 le colonne che sono composte dalle stesse celle piene (quindi non sono riempite necessariamente dallo stesso numero),ma sono composte da una serie di celle vuote e celle piene.
- una volta ridotto il foglio2 dovrei fare in modo che in un nuovo foglio ancora (foglio3) vengano copiate da foglio2 le prime 3 colonne (A,B,C)e la 4 colonna deve essere composta da D (foglio3), poi foglio4 avrà le colonne A,B,C,E, foglio5 A,B,C,F
- a questo punto per i fogli 3-4-5-6 e così via dovrei solamente eliminare le righe che nella colonna D sono vuote
Mamma mia spero che qualcuno di voi possa aiutarmi perché sono disperata!!!!!!!! Io sono riuscita a creare solo l'ultimo punto ma il resto devo farlo a mano! Spero tanto sia possibile.

Grazie ragazzi!
di cromagno data: 18/06/2016 00:45:49
Ciao,
se vuoi ottenere qualche risposta "utile" dovresti allegare un file d'esempio e spiegare (riferendoti a quello) quello che vorresti ottenere.
di r.five data: 18/06/2016 04:48:35
Ottima osservazione, hai proprio ragione!!!! Lo farò appena dispongo del file, ma dici che si può realizzare una cosa di questo tipo o chiedo troppo?

Ho creato ad hoc una cartella in modo che sia più comprensibile
di patel data: 18/06/2016 07:38:18
si può far tutto se si sa cosa si deve fare, hai allegato il file ma privo di spiegazioni, comunque per compiere operazioni ripetitive si può usare anche il registratore di macro.
di r.five data: 19/06/2016 00:34:33
Ragazzi, nessuno di voi riesce a darmi una mano??????
di patel data: 30/06/2016 12:34:44
prima ci devi spiegare bene tutto e riallegare un file serio, tu dai una mano a noi e noi a te
di r.five data: 30/06/2016 12:47:09
Ciao patel, prova a vedere se il file allegato è più chiaro
di alfrimpa data: 30/06/2016 14:05:11
@ r.five

Il file che hai allegato non si riesce ad aprire con Excel; dice formato non valido.

Alfredo
di r.five data: 30/06/2016 14:31:15
ho allegato un altro file, spero questo sia corretto e si riesca a visualizzare.

Grazie mille
di Vecchio Frac data: 30/06/2016 15:00:36
Non è particolarmente difficile da automatizzare se la regola esposta è sempre quella.

Domande:
- nel file di esempio, la colonna "A02f34" viene quindi perduta definitivamente, perchè la struttura è uguale alla prima colonna che si incontra che abbia una struttura simile (nel caso: "V01i00") ?
- potrebbero esserci ulteriori colonne successive di struttura simile, che vengono parimenti scartate?
- è nota a priori l'estensione della tabella o possono esserci n colonne di dati a seguire?
- il foglio definitivo deve presentarsi come una serie di colonne affiancate compattate colonne o vuoi ogni sottotabella a sè stante?
- sei in grado di comprendere e maneggaire eventuale codice VBA che ti venga proposto, al fine di essere autonomo nella modifica/correzione futura?
di r.five data: 30/06/2016 15:56:04
Allora

- si la colonna che presenta una sequenza di celle uguale ad una precedente viene definitivamente eliminata. (E' per questo che la prima operazione sarebbe copiare il foglio prima di cominciare a scorporarlo).

- Il numero di colonne è variabile quindi non è nota a priori l'estensione di tutta la tabella. Io ho solo riportato poche colonne di esempio in modo da rendere chiari i i passaggi da eseguire.

- Per ora vanno bene le sottotabelle a se stanti

- purtopppo ho avuto a che fare poco con la programmazione solo in qualche esame all'università quindi posso provare ma se continuate a darmi una mano è molto meglio, perchè ho provato un p0' da sola ma sono solo riuscita a fare qualche singola operazione.

Grazie ancora

di Vecchio Frac data: 30/06/2016 16:01:43
Allora andiamo per gradi.
Ecco uno spunto (per te ma anche per chi ha voglia di partecipare).
Si basa strettamente sull'esempio che hai offerto (posizione delle colonne e delle righe).
Per verificarlo a pieno devi lanciarlo da un modulo e controllare la finestra Immediata (il risultato dell'elaborazione è lì). Se questo primo passo è soddisfacente allora generalizziamo.

Rinnovo l'invito agli altri a partecipare perchè io non posso garantire continuità anche se mi è tornata la voglia :)
p.s. il titolo è fuorviante... non c'è quasi niente di impossibile, neanche farmi stare lontano dal forum e dai miei amici virtuali ^_^

Option Explicit

Sub mask_column()
Dim v As Variant, itm As Variant, i As Long, j As Long, col As Long
Dim a_column(1 To 20) As String, all_columns(1 To 5) As String

'l'idea è tradurre ogni colonna di dati in una sequenza di uno e zero:
'000100011 indica per esempio tre celle vuote seguite da una piena, poi tre vuote e quindi due piene
'poi si confrontano tra loro queste stringhe: a stringa uguale corrisponde struttura uguale
    
    For col = 4 To 8
        'memorizza la sequenza di valori delle celle colonna per colonna da D5:D24 a H5:H24
        v = Application.Transpose(Range(Cells(5, col), Cells(24, col)))
    
        i = 0
        For Each itm In v       'per ogni elemento di ogni colonna da riga 5 a riga 24
            i = i + 1
            a_column(i) = "0"                       'memorizza zero se la cella è vuota,
            If itm <> "" Then a_column(i) = "1"     '1 se l cella è piena
        Next
        
        all_columns(col - 3) = Join(a_column, "")   'crea l'array delle cinque colonne da D a H con la sequenza delle celle valorizzate
        Erase a_column                              'si prepara a raccogliere il dato della prossima colonna
    Next

    'procede al confronto tra le colonne per eliminare le colonne con struttura simile
    For i = 1 To 4
        For j = i + 1 To 5
            If all_columns(j) = all_columns(i) Then
                Debug.Print "La colonna " & Chr(j + 67) & " è simile alla colonna " & Chr(i + 67)    'piccolo edit :)
            End If
        Next
    Next
End Sub

di r.five data: 30/06/2016 16:23:38
ho provato ma non succede niente :(
di Vecchio Frac data: 30/06/2016 16:30:00
Certo che non sembra succedere niente: siamo ancora in fase di studio; ho detto che devi
cit. " controllare la finestra Immediata (il risultato dell'elaborazione è lì)"

di Vecchio Frac data: 30/06/2016 19:31:09
Seconda versione... questa volta vedrai un risultato sul foglio :)

Option Explicit

Sub mask_column2()
Dim v As Variant, itm As Variant, i As Long, j As Long, col As Long
Dim a_column(1 To 20) As String, all_columns(1 To 5) As String
Dim my_coll As Collection

'l'idea è tradurre ogni colonna di dati in una sequenza di uno e zero:
'000100011 indica per esempio tre celle vuote seguite da una piena, poi tre vuote e quindi due piene
'poi si confrontano tra loro queste stringhe: a stringa uguale corrisponde struttura uguale
    
    For col = 4 To 8
        'memorizza la sequenza di valori delle celle colonna per colonna da D5:D24 a H5:H24
        v = Application.Transpose(Range(Cells(5, col), Cells(24, col)))
    
        i = 0
        For Each itm In v       'per ogni elemento di ogni colonna da riga 5 a riga 24
            i = i + 1
            a_column(i) = "0"                       'memorizza zero se la cella è vuota,
            If itm <> "" Then a_column(i) = "1"     '1 se la cella è piena
        Next
        
        all_columns(col - 3) = Join(a_column, "")   'crea l'array delle cinque colonne da D a H con la sequenza delle celle valorizzate
        Erase a_column                              'si prepara a raccogliere il dato della prossima colonna
    Next

    'procede al confronto tra le colonne per eliminare le colonne con struttura simile
    'sfrutta la tecnica della Collection per eliminare i duplicati
    'chiave della Collection è l'indice della prima colonna univoca
    'che possiamo trattare come Offset per costruire le tabelle successive
    Set my_coll = New Collection
    
    On Error Resume Next
    
    For i = 1 To 5
        my_coll.Add CStr(i), all_columns(i)
    Next
    
    On Error GoTo 0

    'adesso SOLO PER TEST ricopia le colonne univoche in altra zona del foglio
    Range("A26..H50").Clear
    Range("A5..C24").Copy Range("A30")
    For i = 1 To my_coll.Count
        Range("C1..C24").Offset(, my_coll(i)).Copy Range("C26").Offset(, i)
    Next

End Sub

di Cucù data: 30/06/2016 20:24:37
@VF
Non ricordo tuo codice così ben commentato...
La lontananza in fin dei conti ti ha giovato

di Vecchio Frac data: 30/06/2016 20:49:40
Terza versione.
Funziona come vuoi e ok, si può fare di meglio.
Ma adesso vado a vedere la partita :)

p.s. è molto importante che nella prima riga (la riga 1) del foglio ci sia solamente la tabella originale con le sue intestazioni e che dopo detta tabella non ci sia altro. Insomma, mi sono basato sul file di esempio originale. Fai girare la macro e fai sapere cosa ne dici.

Option Explicit

Sub mask_column3()
Dim v As Variant, itm As Variant, i As Long, j As Long, col As Long, num As Long
Dim a_column(1 To 20) As String, all_columns(1 To 5) As String
Dim my_coll As Collection

'l'idea è tradurre ogni colonna di dati in una sequenza di uno e zero:
'000100011 indica per esempio tre celle vuote seguite da una piena, poi tre vuote e quindi due piene
'poi si confrontano tra loro queste stringhe: a stringa uguale corrisponde struttura uguale
    
    num = [COUNTA(1:1)]  'conta le celle valorizzate in riga 1 per predire quante sono le colonne da esaminare
    For col = 4 To 4 + num - 1
        'memorizza la sequenza di valori delle celle colonna per colonna da D5:D24 a H5:H24
        v = Application.Transpose(Range(Cells(5, col), Cells(24, col)))
    
        i = 0
        For Each itm In v       'per ogni elemento di ogni colonna da riga 5 a riga 24
            i = i + 1
            a_column(i) = "0"                       'memorizza zero se la cella è vuota,
            If itm <> "" Then a_column(i) = "1"     '1 se la cella è piena
        Next
        
        all_columns(col - 3) = Join(a_column, "")   'crea l'array delle cinque colonne da D a H con la sequenza delle celle valorizzate
        Erase a_column                              'si prepara a raccogliere il dato della prossima colonna
    Next

    'procede al confronto tra le colonne per eliminare le colonne con struttura simile
    'sfrutta la tecnica della Collection per eliminare i duplicati
    'chiave della Collection è l'indice della prima colonna univoca
    'che possiamo trattare come Offset per co-struire le tabelle successive
    Set my_coll = New Collection
    
    On Error Resume Next
    
    For i = 1 To 5
        my_coll.Add CStr(i), all_columns(i)
    Next
    
    On Error GoTo 0

    'adesso ricopia le colonne univoche in altra zona del foglio
    Range("26..50").Clear
    Range(Cells(1, 4 + num + 1), Cells(24, 4 + num + 1 + my_coll.Count * 4)).Clear
    Range("A5..C24").Copy Range("A30")
    For i = 1 To my_coll.Count
        Range("C1..C24").Offset(, my_coll(i)).Copy Range("C26").Offset(, i)
    Next

    'quindi effettua l'estrazione tabella per tabella e la riporta nello stesso foglio
    'a fianco della tabella originale
    For i = 1 To my_coll.Count
        Range("29:29").AutoFilter
        Range("D29:D49").AutoFilter Field:=3 + i, Criteria1:="<>"
        Range("A26:C49").SpecialCells(xlCellTypeVisible).Copy Cells(2, 4 + num + 2 + (i - 1) * 5)
        Range("D26:D49").Offset(, i - 1).SpecialCells(xlCellTypeVisible).Copy Cells(2, 4 + 3 + num + 2 + (i - 1) * 5)
        Range("29:29").AutoFilter
    Next
End Sub

di Vecchio Frac data: 30/06/2016 20:50:20
@Cucù
Grazie :)
di r.five data: 30/06/2016 21:31:37
io torno e vai via tu! :) ho provato la terza versione ma mi da errore... adesso la guardo bene :) vediamo se ci capisco qualcosa. Dove sei stato? come mai lontananza? adesso sono curiosa! :)

Mi correggo: adesso si che è andato!!!!!!!!! oddio non ci credo bravissimo!!! allora...adesso controllo bene e ti dico :) :)

Quello che hai fatto è perfetto, deve proprio presentarsi cosi, mi chiedevo....è possibile fare in modo che le tabelle che hai messo a fianco siano posizionati in nuovi fogli?????????

Altra domanda...allora effettivamente le cartelle di lavoro sono composte da tantissime colonne, e circa 25-30 righe ma è variabile come dato quindi bisognerebbe cercare il modo di dire procedi a fare le operazioni fino alla colonna prima della colonna vuota (perchè il foglio è composta dalla tabella che si conclude con colonna vuota)

di Vecchio Frac data: 30/06/2016 23:04:05
Quarta versione, forse l'ultima :)
Adesso viene creato un foglio nuovo prima di ogni inserimento delle sottotabelle compattate. E questo risponde alla prima delle due ultime richieste.
Quanto alla seconda richiesta ("bisognerebbe cercare il modo di dire procedi a fare le operazioni fino alla colonna prima della colonna vuota") dovrebbe già comportarsi così perchè nella variabile iniziale "num" cerco di recuperare il numero di colonne da esaminare (e quindi di sottotabelle da creare).

Option Explicit

Sub mask_column4()
Dim v As Variant, itm As Variant, i As Long, j As Long, col As Long, num As Long
Dim a_column(1 To 20) As String, all_columns(1 To 5) As String
Dim my_coll As Collection
Dim sh As Worksheet, activesh As Worksheet

'l'idea è tradurre ogni colonna di dati in una sequenza di uno e zero:
'000100011 indica per esempio tre celle vuote seguite da una piena, poi tre vuote e quindi due piene
'poi si confrontano tra loro queste stringhe: a stringa uguale corrisponde struttura uguale
    
    num = [COUNTA(1:1)]  'conta le celle valorizzate in riga 1 per predire quante sono le colonne da esaminare
    For col = 4 To 4 + num - 1
        'memorizza la sequenza di valori delle celle colonna per colonna da D5:D24 a H5:H24
        v = Application.Transpose(Range(Cells(5, col), Cells(24, col)))
    
        i = 0
        For Each itm In v       'per ogni elemento di ogni colonna da riga 5 a riga 24
            i = i + 1
            a_column(i) = "0"                       'memorizza zero se la cella è vuota,
            If itm <> "" Then a_column(i) = "1"     '1 se la cella è piena
        Next
        
        all_columns(col - 3) = Join(a_column, "")   'crea l'array delle cinque colonne da D a H con la sequenza delle celle valorizzate
        Erase a_column                              'si prepara a raccogliere il dato della prossima colonna
    Next

    'procede al confronto tra le colonne per eliminare le colonne con struttura simile
    'sfrutta la tecnica della Collection per eliminare i duplicati
    'chiave della Collection è l'indice della prima colonna univoca
    'che possiamo trattare come Offset per co-struire le tabelle successive
    Set my_coll = New Collection
    
    On Error Resume Next
    
    For i = 1 To 5
        my_coll.Add CStr(i), all_columns(i)
    Next
    
    On Error GoTo 0

    'adesso ricopia le colonne univoche in altra zona del foglio
    Range("26..50").Clear
    Range(Cells(1, 4 + num + 1), Cells(24, 4 + num + 1 + my_coll.Count * 4)).Clear
    Range("A5..C24").Copy Range("A30")
    For i = 1 To my_coll.Count
        Range("C1..C24").Offset(, my_coll(i)).Copy Range("C26").Offset(, i)
    Next

    'quindi effettua l'estrazione tabella per tabella e la riporta nello stesso foglio
    'a fianco della tabella originale
    Set activesh = ActiveSheet
    For i = 1 To my_coll.Count
        With activesh
            .Range("29:29").AutoFilter
            .Range("D29:D49").AutoFilter Field:=3 + i, Criteria1:="<>"
            Set sh = Sheets.Add
            .Range("A26:C49").SpecialCells(xlCellTypeVisible).Copy sh.Cells(1, 1)
            .Range("D26:D49").Offset(, i - 1).SpecialCells(xlCellTypeVisible).Copy sh.Cells(1, 4)
            .Range("29:29").AutoFilter
        End With
    Next
End Sub

di r.five data: 01/07/2016 01:51:46
ottimo adesso apre i fogli!!!!!!!!!!! oddio sono emozionata ce l'hai davvero fatta....e la prima tabellina quella con le colonne tutte diverse non è possibile metterla in un nuovo foglio?????????
di Vecchio Frac data: 01/07/2016 07:42:40
cit. "e la prima tabellina quella con le colonne tutte diverse non è possibile metterla in un nuovo foglio?"
---> Naturalmente sì. Vuoi provarci da solo? Non è difficile, anzi è abbastanza chiaro il punto dove il codice copia le colonne univoche in altra zona del foglio, basta aggiungere un foglio e correggere i giusti riferimenti come nella parte finale del codice stesso.
di r.five data: 01/07/2016 07:44:56
Ok ci provo da sola!!!! 💪🏻💪🏻💪🏻💪🏻💪🏻 intanto grazie infinite!!!! 😊
di Vecchio Frac data: 01/07/2016 10:41:17

Bene. Fai sapere i progressi.

Vuoi Approfondire?