Pagina precedente | 1 | Pagina successiva
Vota | Stampa | Notifica email    
Autore

Duplicare elenco verticale in orizzontale

Ultimo Aggiornamento: 05/02/2019 20:34
Post: 91
Registrato il: 08/12/2013
Utente Junior
Excel 2010
OFFLINE
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
Post: 3.698
Registrato il: 28/06/2011
Città: AGORDO
Età: 70
Utente Master
2013
OFFLINE
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
Post: 91
Registrato il: 08/12/2013
Utente Junior
Excel 2010
OFFLINE
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]
Post: 3.699
Registrato il: 28/06/2011
Città: AGORDO
Età: 70
Utente Master
2013
OFFLINE
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
Post: 92
Registrato il: 08/12/2013
Utente Junior
Excel 2010
OFFLINE
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
Post: 3.700
Registrato il: 28/06/2011
Città: AGORDO
Età: 70
Utente Master
2013
OFFLINE
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
Post: 93
Registrato il: 08/12/2013
Utente Junior
Excel 2010
OFFLINE
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


Post: 3.703
Registrato il: 28/06/2011
Città: AGORDO
Età: 70
Utente Master
2013
OFFLINE
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
Post: 94
Registrato il: 08/12/2013
Utente Junior
Excel 2010
OFFLINE
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
Post: 3.706
Registrato il: 28/06/2011
Città: AGORDO
Età: 70
Utente Master
2013
OFFLINE
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
Vota:
Amministra Discussione: | Chiudi | Sposta | Cancella | Modifica | Notifica email Pagina precedente | 1 | Pagina successiva
Nuova Discussione
 | 
Rispondi
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 14:36. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com