Excel Forum Per condividere esperienze su Microsoft Excel

Duplicare elenco verticale in orizzontale

  • Messaggi
  • OFFLINE
    franco28.2013
    Post: 91
    Registrato il: 08/12/2013
    Utente Junior
    Excel 2010
    00 03/02/2019 10:17
    Ciao a tutti.

    Ho un foglio in cui sono elencati i lavoratori di un’azienda con i relativi familiari (celle A4:G14).
    Nell'elenco è presente un filtro automatico (A3:R3) in modo da selezionare il lavoratore desiderato all'occorrenza.
    Ho bisogno di riportare i familiari di ogni lavoratore in un’unica riga in corrispondenza della prima riga in cui è indicato il lavoratore a partire dalla prima colonna utile dello stesso foglio. Nell'esempio allegato i dati devono essere duplicati nelle celle I4:R14.
    Tale duplicazione è utile per la stampa unione di un modello word collegato all'elenco in argomento.
    Allego file per far comprendere meglio la problematica e il risultato atteso.

    Grazie per l'aiuto che potrete darmi.

    Franco
  • OFFLINE
    raffaele1953
    Post: 3.698
    Registrato il: 28/06/2011
    Città: AGORDO
    Età: 70
    Utente Master
    2013
    00 03/02/2019 12:23
    Importanti le parole CONIUGATO,SEPARATO,CELIBE... Pure 0/1/2 ecc figli 
    Option Explicit
Sub Orriz()
Dim Ur, R, X, Y, C
Ur = Range("A" & Rows.Count).End(xlUp).Row
For X = 4 To Ur
    If Cells(X, 3) = "CELIBE" Then
        C = 13
        Range(Cells(X, 1), Cells(X, 2)).Copy
        Cells(X, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        If Cells(X, 4) <> 0 Then
            For Y = 0 To Cells(X, 4)
                Range(Cells(X, 6 + C), Cells(X, 7 + C)).Copy
                Cells(X, 6 + C).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                C = C + 2
            Next Y
        End If
    ElseIf Cells(X, 3) = "SEPARATO" Then
        Range(Cells(X, 1), Cells(X, 2)).Copy
        Cells(X, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        If Cells(X, 4) > 0 Then
            C = 13
            For Y = 1 To Cells(X, 4)
                Range(Cells(X + Y, 6), Cells(X + Y, 7)).Copy
                Cells(X, C).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                C = C + 2
            Next Y
            X = X + Y
        End If
    ElseIf Cells(X, 3) = "CONIUGATO" Then
        Range(Cells(X, 1), Cells(X, 2)).Copy
        Cells(X, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Range(Cells(X, 6), Cells(X, 7)).Copy
        Cells(X, 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        If Cells(X, 4) > 0 Then
            C = 13
            For Y = 1 To Cells(X, 4)
                Range(Cells(X + Y, 6), Cells(X + Y, 7)).Copy
                Cells(X, C).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                C = C + 2
            Next Y
            X = X + Y
        End If
    End If
Next X
End Sub
    Excel 2013
  • OFFLINE
    franco28.2013
    Post: 91
    Registrato il: 08/12/2013
    Utente Junior
    Excel 2010
    00 03/02/2019 17:51
    Ciao a tutti.

    Grazie Raffaele per la tua proposta. Purtroppo, ci sono alcuni errori nel codice da te elaborato (vedi foglio "Test-VBA" nel nuovo file allegato).
    Nel frattempo, ho trovato alcune formule basate su CERCA.VERT ma ci sono ancora alcuni errori che non riesco a eliminare (vedi foglio "Test-FORMULE").

    Chiedo a tutti un aiuto ulteriore. Grazie.

    Franco
    [Modificato da franco28.2013 03/02/2019 22:38]
  • OFFLINE
    raffaele1953
    Post: 3.699
    Registrato il: 28/06/2011
    Città: AGORDO
    Età: 70
    Utente Master
    2013
    00 03/02/2019 20:13
    >>> vedi foglio "Test-VBA" nel nuovo file allegato
    Non esiste + quali sono gli errori ???
    Neppure foglio "Test-FORMULE" col quale presumo non riuscirai
    Excel 2013
  • OFFLINE
    franco28.2013
    Post: 92
    Registrato il: 08/12/2013
    Utente Junior
    Excel 2010
    00 03/02/2019 22:42
    Ciao.

    Scusatemi. Nel mio post precedente ho allegato il file sbagliato.
    Ora l'ho sostituito con quello giusto.
    Buonanotte.
    Franco
  • OFFLINE
    raffaele1953
    Post: 3.700
    Registrato il: 28/06/2011
    Città: AGORDO
    Età: 70
    Utente Master
    2013
    00 04/02/2019 01:54
    Penso sia impossibile con le formule, dovresti cambiare la struttura del file e mettere in ogni riga tutti i dati dell'operatore. Un cerca.vert sarebbe idoneo
    VBA (a condizione che siano ordinate) Sub Orriz_A, oppure Sub Orriz_B che elimina righe vuote 
    Option Explicit
Sub Orriz_A()
Dim Ur, R, X, Y, C
Ur = Range("A" & Rows.Count).End(xlUp).Row
If Ur > 3 Then Range("I4:R" & Ur).ClearContents
For X = 4 To Ur
    If Cells(X, 3) = "CELIBE" Then
        Range(Cells(X, 1), Cells(X, 2)).Copy
        Cells(X, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        C = 13
        If Cells(X, 4) <> 0 Then
            For Y = 0 To Cells(X, 4)
                Range(Cells(X, 6 + C), Cells(X, 7 + C)).Copy
                Cells(X, 6 + C).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                C = C + 2
            Next Y
        End If
        X = X + Cells(X, 4)
    ElseIf Cells(X, 3) = "SEPARATO" Then
        Range(Cells(X, 1), Cells(X, 2)).Copy
        Cells(X, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        C = 13
        If Cells(X, 4) > 0 Then
            For Y = 1 To Cells(X, 4)
                Range(Cells(X + Y, 6), Cells(X + Y, 7)).Copy
                Cells(X, C).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                C = C + 2
            Next Y
        End If
        X = X + (Cells(X, 4) - 1)
    ElseIf Cells(X, 3) = "CONIUGATO" Then
        Range(Cells(X, 1), Cells(X, 2)).Copy
        Cells(X, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Range(Cells(X, 6), Cells(X, 7)).Copy
        Cells(X, 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        C = 13
        If Cells(X, 4) > 0 Then
            For Y = 1 To Cells(X, 4)
                Range(Cells(X + Y, 6), Cells(X + Y, 7)).Copy
                Cells(X, C).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                C = C + 2
            Next Y
        End If
        X = X + Cells(X, 4)
    End If
Next X
End Sub
Sub Orriz_B()
Dim Ur, R, X, Y, C
Ur = Range("A" & Rows.Count).End(xlUp).Row
If Ur > 3 Then Range("I4:R" & Ur).ClearContents
R = 4
For X = 4 To Ur
    If Cells(X, 3) = "CELIBE" Then
        Range(Cells(X, 1), Cells(X, 2)).Copy
        Cells(R, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        C = 13
        If Cells(X, 4) <> 0 Then
            For Y = 0 To Cells(X, 4)
                Range(Cells(X, 6 + C), Cells(X, 7 + C)).Copy
                Cells(R, 6 + C).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                C = C + 2
            Next Y
        End If
        X = X + Cells(X, 4)
        R = R + 1
    ElseIf Cells(X, 3) = "SEPARATO" Then
        Range(Cells(X, 1), Cells(X, 2)).Copy
        Cells(R, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        C = 13
        If Cells(X, 4) > 0 Then
            For Y = 1 To Cells(X, 4)
                Range(Cells(X + Y, 6), Cells(X + Y, 7)).Copy
                Cells(R, C).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                C = C + 2
            Next Y
        End If
        X = X + (Cells(X, 4) - 1)
        R = R + 1
    ElseIf Cells(X, 3) = "CONIUGATO" Then
        Range(Cells(X, 1), Cells(X, 2)).Copy
        Cells(R, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Range(Cells(X, 6), Cells(X, 7)).Copy
        Cells(R, 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        C = 13
        If Cells(X, 4) > 0 Then
            For Y = 1 To Cells(X, 4)
                Range(Cells(X + Y, 6), Cells(X + Y, 7)).Copy
                Cells(R, C).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                C = C + 2
            Next Y
        End If
        X = X + Cells(X, 4)
        R = R + 1
    End If
Next X
End Sub
    [Modificato da raffaele1953 04/02/2019 12:01]
    Excel 2013
  • OFFLINE
    franco28.2013
    Post: 93
    Registrato il: 08/12/2013
    Utente Junior
    Excel 2010
    00 04/02/2019 23:17
    Ciao a tutti.

    Ho provato la doppia macro proposta: è molto utile la possibilità di elencare i duplicati anche in modo raggruppato, uno di seguito all'altro senza righe vuote di intervallo. Ho inserito altri casi (vedovo o celibe con o senza figli oppure lavoratore con cognome e nome identici ma data nascita diversa) ma non sono riuscito a modificare il codice vba per far quadrare il tutto. Forse sarebbe meglio modulare il codice in base a n.figli e parentela (coniuge e figli presenti o assenti) senza tener conto dello stato civile.

    Saluti.
    Franco


  • OFFLINE
    raffaele1953
    Post: 3.703
    Registrato il: 28/06/2011
    Città: AGORDO
    Età: 70
    Utente Master
    2013
    00 05/02/2019 02:42
    A parte miei errori di scrittura VBA ...(ho aggiunto Vedovo)

    Per come hai disposto i dati, mi sembra l'unico modo possibile
    Però, tutto questo è soggetto ad errori Tuoi di scrittura (compreso nell'ordine dei dati)
    Ex riga20 dici che ha due figli, mà il secondo figlio non esiste
    Inoltre non contempla voci... Ex Figlia,Vedova,Separata oppure Figglio
    Ripeto, 1o farei la tabella di sinistra con solo una riga per ogni operatore (anche in altro foglio. Vedi ELENCO ORIZZONTALE con una sola formula ricavi il tutto. Se ci sono intestazioni/colonne che non desideri basta modificare la formula togliendo il ....RIF.COLONNA() ed inserire un numero

    NB. Al VBA basta aggiungere/togliere una colonna che non funziona più
    Excel 2013
  • OFFLINE
    franco28.2013
    Post: 94
    Registrato il: 08/12/2013
    Utente Junior
    Excel 2010
    00 05/02/2019 17:13
    Ciao.

    In effetti stato civile e n. figli possono avere molte variabili, oltre alla presenza di eventuali omonimi. Ciò che interessa in questo elenco è da quante persone è costituto il nucleo familiare e quali sono. Come dici tu, sarebbe più semplice elencare in ogni singola riga il lavoratore con i dati anagrafici dei propri familiari. In tal caso però non basterebbe una sola pagina per elencare tutti i dati utili. La scelta di disporre, invece, tali dati in un elenco sviluppato in senso verticale, da raggruppare per singolo lavoratore all'occorrenza mediante l’uso del filtro automatico, è dovuta alla necessita di far rientrare tutto in una pagina verticale, mentre la necessità di duplicarli nell'ambito dello stesso foglio disponendoli in senso orizzontale in colonne laterali nascoste serve per poter utilizzare tali dati nella “stampa unione” di un foglio di word per la compilazione di documenti.
    La possibilità di fare errori c’è sempre, ma stando attenti si può evitare. Nel tuo ultimo post hai proposto un ELENCO ORIZZONTALE che utilizza nella formula la funzione INDICE, ma questa preleva i dati da un altro elenco orizzontale identico (quello del foglio ELENCO VERTICALE)! Quindi, delle soluzioni proposte preferisco quella con codice VBA, da correggere in alcuni punti, in particolare, nelle parti riguardanti i lavoratori Giallini, Rossi e Verdone dell’esempio presentato. Purtroppo non sono molto pratico del codice VBA.
    Nel file allegato nel mio post #3 ho proposto di utilizzare la formula CERCA.VERT, che in parte risolveva la problematica, ma nessuno ha cercato di correggere gli errori che si evidenziavano.

    Franco
  • OFFLINE
    raffaele1953
    Post: 3.706
    Registrato il: 28/06/2011
    Città: AGORDO
    Età: 70
    Utente Master
    2013
    00 05/02/2019 20:34
    Se desiderate apro un nuovo POST
    Post #3 , secondo TU (chi dovrebbe rispondere al post), dato che è IMPOSSIBILE.
    Nel caso fosse fattibile "solo adesso" per VOI "esperti". Dite la Vostra

    >>> In tal caso però non basterebbe una sola pagina per elencare tutti i dati utili
    Spero che stai scherzando (con oltre 16.000 colonne) ???

    >>>ma questa preleva i dati da un altro elenco orizzontale identico (quello del foglio ELENCO VERTICALE)!
    Puoi sempre cambiare la formula come desideri...???

    Comunque, fai pure come desideri ...(io mi sono già rotto)
    Un Saluto a Te e WORD
    [Modificato da raffaele1953 05/02/2019 22:21]
    Excel 2013
Soluzioni Excel Domande e Risposte
Passa alla versione desktop

  • Anteprima