collegamento tra fogli righe sfalsate

Versione Completa Stampa Cerca Utenti Iscriviti Condividi :

Excel Forum » Excel Forum » » Soluzioni Excel Domande e Risposte

maxma62

00mercoledì 16 novembre 2016 22:32

Ciao a tutti.
Nel workbook allegato ci sono tre fogli, il foglio3 è collegato al foglio1/2.
E' possibile il foglio3 collegarlo al foglio1/2 con righe sfalsate?
Nel workbook c'è l'esempio.
Spero di essermi spiegagato.
Grazie in anticipo.
max

GiuseppeMN

00giovedì 17 novembre 2016 10:14

Buona giornata, Max;
posso proporti questo Codice VBA, da eseguire nel Foglio di lavoro "Foglio3"

Option Explicit

Sub Aggiorna()
Application.ScreenUpdating = False
Dim NrcX As Long, Nrc As Long, x As Long

    Nrc = Range("A" & Rows.Count).End(xlUp).Row
        If Nrc < 2 Then Nrc = 2
    Range(Cells(2, 1), Cells(Nrc, 5)).ClearContents
    With Worksheets("Foglio1")
        NrcX = .Range("A" & Rows.Count).End(xlUp).Row
        Nrc = 2
            For x = 2 To NrcX
                Range(.Cells(x, 1), .Cells(x, 5)).Copy
                Cells(Nrc, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Nrc = Nrc + 2
            Next x
    End With
    With Worksheets("Foglio2")
        NrcX = .Range("A" & Rows.Count).End(xlUp).Row
        Nrc = 3
            For x = 2 To NrcX
                Range(.Cells(x, 1), .Cells(x, 5)).Copy
                Cells(Nrc, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Nrc = Nrc + 2
            Next x
    End With
        Application.CutCopyMode = False
Application.ScreenUpdating = True
    Cells(2, 1).Select
End Sub

A disposizione.

Buon Lavoro e buona serata.

Giuseppe

maxma62

00giovedì 17 novembre 2016 20:01

Grazie giuseppe è o.k. [SM=g27811]

Un saluto.
max

cromagno

10venerdì 18 novembre 2016 09:04

Ciao a tutti,
un'alternativa (lato formule) all'ottima soluzione di Giuseppe (un saluto)...

Nella cella A2 del "Foglio3" (da copiare poi a destra ed in basso):
=INDIRETTO(SCEGLI(VAL.PARI(RIF.RIGA())+1;"Foglio2";"Foglio1")&"!"&INDIRIZZO(INT(RIF.RIGA()/2)+1;RIF.COLONNA()))

Ti riallego il file a scanso di equivoci...

maxma62

00venerdì 18 novembre 2016 20:10

Ciao giuseppe.
La tua macro funziona per il range che ho inserito in #1
E' possibile modificare la macro (mi sono perso) per il nuovo range del workbook allegato?

riga3 foglio "dividi" nella riga2 foglio "unito"
riga3 foglio "descrizione" nella riga3 foglio "unito"

riga4 foglio "dividi" nella riga4 foglio "unito"
riga4 foglio "descrizione" nella riga5 foglio "unito"

riga5 foglio "dividi" nella riga6 foglio "unito"
riga5 foglio "descrizione" nella riga7 foglio "unito"

ecc...
max

GiuseppeMN

00venerdì 18 novembre 2016 21:51

Buona sera, Max;
consentimi un saluto a @ cromagno (Buona serata, Tore; ottima la Tua Soluzione!)

Tornado a noi, Max, potresti provare il Codice VBA:

Option Explicit
 
Sub Aggiorna()
Application.ScreenUpdating = False
Dim NrcX As Long, NrC As Long, Cln As Long, x As Long
 
    NrC = Range("A" & Rows.Count).End(xlUp).Row
    Cln = Cells(1, Columns.Count).End(xlToLeft).Column
        If NrC < 2 Then NrC = 2
    Range(Cells(2, 1), Cells(NrC, Cln)).ClearContents '<<< 2,1 = A1 5=E
    With Worksheets("dividi") '<<< nome foglio
        Cln = .Cells(2, Columns.Count).End(xlToLeft).Column
        NrcX = .Range("A" & Rows.Count).End(xlUp).Row
        NrC = 2
            For x = 3 To NrcX
                Range(.Cells(x, 1), .Cells(x, Cln)).Copy
                Cells(NrC, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    NrC = NrC + 2
            Next x
    End With
    With Worksheets("descrizione")
        Cln = .Cells(2, Columns.Count).End(xlToLeft).Column
        NrcX = .Range("A" & Rows.Count).End(xlUp).Row
        NrC = 3
            For x = 3 To NrcX
                Range(.Cells(x, 1), .Cells(x, Cln)).Copy
                Cells(NrC, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    NrC = NrC + 2
            Next x
    End With
        Application.CutCopyMode = False
Application.ScreenUpdating = True
    Cells(2, 1).Select
End Sub

A disposizione.

Buona serata.

Giuseppe

GiuseppeMN

00venerdì 18 novembre 2016 21:57

Solo una precisazione:
'<<< 2,1 = A1 5=E
se ho interpretato correttamente la TUa intenzione, non credo sia esattamente così; ma:
'<<< 2,1 = A2 5=E

Giuseppe

maxma62

00venerdì 18 novembre 2016 23:10

Ciao giuseppe,
la seconda macro non incolla come chiedevo.
Dopo molte modifiche ho modificato la prima macro così:

Option Explicit
 
Sub Aggiorna()
Application.ScreenUpdating = False
Dim NrcX As Long, NrC As Long, x As Long
 
    NrC = Range("A" & Rows.Count).End(xlUp).Row
        If NrC < 2 Then NrC = 3
        
    Range(Cells(2, 1), Cells(NrC, 18)).ClearContents '<<< 2,1 = A1 5=E
    
    
    With Worksheets("dividi") '<<< nome foglio
        NrcX = .Range("A" & Rows.Count).End(xlUp).Row
        NrC = 3 '<< copia in riga 2
            For x = 3 To NrcX '<<< parte da riga 3
            
                Range(.Cells(x, 1), .Cells(x, 18)).Copy
                
                Cells(NrC, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    NrC = NrC + 2
            Next x
    End With
    
    
    With Worksheets("descrizione")
        NrcX = .Range("A" & Rows.Count).End(xlUp).Row
        NrC = 4 '<<< copia in riga 3
            For x = 3 To NrcX '<<< parte da riga 3
            
                Range(.Cells(x, 1), .Cells(x, 18)).Copy
                
                Cells(NrC, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    NrC = NrC + 2
            Next x
    End With
    
    
        Application.CutCopyMode = False
Application.ScreenUpdating = True
    Cells(2, 1).Select
End Sub

che gira bene per la mia seconda richiesta.
Mi puoi scrivere nella macro quali sono le righe che copia?
max

GiuseppeMN

00sabato 19 novembre 2016 05:20

Buona giornata, Max;
l'unica differenza che posso rilevare tra il Tuo Codice VBA e quello proposto in Risposta #6 è nella definizione delle Colonne da considerare nei Range da copiare.

Nel Tuo Codice VBA è definito in 18 Colonne a prescindere; nel mio Codice VBA il numero delle Colonne è calcolato con la Variabile "Cln".
Questo tipo di soluzione, nel mio Codice VBA, consente di poter gestire l'aggiunta di eventuali ulteriori "Campi" (Colonne) nei tre Fogli di lavoro.
Prendendo ad esmpio il Tuo File proposto in #5, le Colonne calcolate sono 18 nel Foglio di lavoro "dividi" mentre, nel Foglio di lavoro "descrizione", avremo una sola Colonna.

Riporto il Codice VBA con i commenti a margine delle istruzioni.

Option Explicit
 
Sub Aggiorna()
Application.ScreenUpdating = False
Dim NrcX As Long, NrC As Long, Cln As Long, x As Long   '   Definisce le Variabili
 
    NrC = Range("A" & Rows.Count).End(xlUp).Row '   Righe da considerare in "unito"
    Cln = Cells(1, Columns.Count).End(xlToLeft).Column  '   Colonne da considerare in "unito"
        If NrC < 2 Then NrC = 2
    Range(Cells(2, 1), Cells(NrC, Cln)).ClearContents '<<< 2,1 = A2 Cln = R (Cln = 18)
    
    With Worksheets("dividi") '<<< nome foglio
        Cln = .Cells(2, Columns.Count).End(xlToLeft).Column '   Colonne da considerare in "dividi"
        NrcX = .Range("A" & Rows.Count).End(xlUp).Row   '   Righe da considerare in "dividi"
        NrC = 2     '   Definisce la Riga da cui partire in "unito"
        
            For x = 3 To NrcX   '   3 = Riga da cui partire in "dividi"
                Range(.Cells(x, 1), .Cells(x, Cln)).Copy    '   Definisce il Range da copiare (Cln = 18)
                Cells(NrC, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '   Incolla "Valori" in "unito"
                    NrC = NrC + 2   '   Incremento in "unito"
            Next x
            
    End With
    
    
    With Worksheets("descrizione")  '   Nome Foglio di lavoro
        Cln = .Cells(2, Columns.Count).End(xlToLeft).Column '   Colonne da considerare in "descrizione"
        NrcX = .Range("A" & Rows.Count).End(xlUp).Row   '   Righe da considerare in "descrizione"
        NrC = 3     '   Definisce la Riga da cui partire in "unito"
            
            For x = 3 To NrcX   '   3 = Riga da cui partire in "descrizione"
                Range(.Cells(x, 1), .Cells(x, Cln)).Copy    '   Definisce il Range da copiare (Cln = 1)
                Cells(NrC, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '   Incolla "Valori" in "unito"
                    NrC = NrC + 2   '   Incremento in "unito"
            Next x
            
    End With
        Application.CutCopyMode = False '   Dichiara la fine del "Copia"
Application.ScreenUpdating = True
    Cells(2, 1).Select  '   Posiziona il Cursore in Cella "A2"
End Sub

Allego il File con il quale ho eseguito i miei Test.

A disposizione.

Buona serata.

Giuseppe

Questa è la versione 'lo-fi' del Forum Per visualizzare la versione completa clicca qui
Tutti gli orari sono GMT+01:00. Adesso sono le 16:52.