Unire fogli con selezione colonne

[vecchio fracSenior Moderator vecchio frac Karma: 249 pts]

Allora eccomi qui, non è stato semplice ma credo di aver ottenuto un risultato. Esaminando bene il tuo codice, ho notato che, alla fine, la mia proposta iniziale non era male, ma andava affinata.

Quindi ecco qui il codice risultato finale.

Ho una perplessità peraltro, cioè che dal terzo foglio tu recuperi due volte la colonna L. Questo risulta nell'ultimo file di esempio che hai postato. Comunque il codice funziona bene e fa quello che chiedi, si tratta ora di aggiustare eventuali sbavature o correggere piccoli riposizionamenti di colonne.

Guardati il mio codice e se c'è qualche passaggio poco chiaro, chiedi pure spiegazioni sul funzionamento.

Option Explicit

Sub creareDBRISULTATI()
Dim r As Range
Dim i As Integer
Dim lRow As Long, lCol As Long
Dim rowMax As Long
Dim v As Variant
Dim sequenza As String

    Sheets("Risultati").Activate
    Sheets("Risultati").Range("A2:Z65536").Clear
    
    lRow = 2

    For i = 1 To 3
        With Sheets("Foglio" & i)
            sequenza = Choose(i, "A B C D G J H Q S T V W", _
                                 "B D E F M L K H Q G I R", _
                                 "E J B D H O L C L I P")
            lCol = 2
            rowMax = 0
            For Each v In Split(sequenza)
                Set r = .Range(.Cells(2, v), .Cells(2, v).End(xlDown))
                rowMax = Application.Max(rowMax, Application.CountA(r))
                r.Copy Sheets("Risultati").Cells(lRow, lCol)
                If i = 3 And v = "I" Then
                    Set r = Sheets("Risultati").Range(Cells(lRow, lCol), Cells(lRow + rowMax - 1, lCol))
                    r = Evaluate(r.Address & "* 1000")
                End If
                lCol = lCol + 1
                If i = 3 And v = "H" Then lCol = 7
            Next
            
            Sheets("Risultati").Range(Cells(lRow, "Z"), Cells(lRow + rowMax - 1, "Z")).Value = "Foglio" & i
            lRow = lRow + rowMax
        End With
    Next i
End Sub

[mark_solPartecipante mark_sol]

Errata Corrige vecchio frac

Non avevo visto letto la risposta , provo a capire soprattutto e completamente diverso da quanto avevo provato a fare.

Grazie e buona serata

[vecchio fracSenior Moderator vecchio frac Karma: 249 pts]

mark_sol ha scritto:

Errata Corrige vecchio frac

Non capisco l'Errata Corrige 🙂

Sì il codice è diverso dal tuo ma fa la stessa cosa e con pazienza vedrai che riesci a capirlo tutto 😛

[mark_solPartecipante mark_sol]

L'errata corrige è dovuta al fatto che avevo postato prove che non andavano bene, senza rendermi conto della soluzione che avevi proposto e ho preferito cancellarla.

Questa sera avrò il tempo di studiarmelo come si deve per comprendere come sei arrivato al risultato, che è perfetto.

Grazie

[vecchio fracSenior Moderator vecchio frac Karma: 249 pts]

mark_sol ha scritto:

che è perfetto

Mi interessava sapere questo    

[vecchio fracSenior Moderator vecchio frac Karma: 249 pts]

A seguito della tua segnalazione ho rivisto la parte del codice che dava problemi.

Sostituisci quindi tutta la procedura con la nuova revisione:

Option Explicit

Sub creareDBRISULTATI()
Dim r As Range
Dim i As Integer
Dim lRow As Long, lCol As Long
Dim rowMax As Long
Dim v As Variant
Dim sequenza As String

    Sheets("Risultati").Activate
    Sheets("Risultati").Range("A2:Z65536").Clear
    
    lRow = 2

    For i = 1 To 3
        With Sheets("Foglio" & i)
            sequenza = Choose(i, "A B C D G J H Q S T V W", _
                                 "B D E F M L K H Q G I R", _
                                 "E J B A D H M L C L I O")

            lCol = 2
            rowMax = .Range("B2").End(xlDown).Row
            For Each v In Split(sequenza)
                Set r = .Range(.Cells(2, v), .Cells(rowMax, v))
                r.Copy Sheets("Risultati").Cells(lRow, lCol)
                If i = 3 And v = "I" Then
                    Set r = Sheets("Risultati").Range(Cells(lRow, lCol), Cells(lRow + rowMax - 1, lCol))
                    r = Evaluate(r.Address & "* 1000")
                End If
                lCol = lCol + 1
                If i = 3 And v = "H" Then lCol = 7
            Next
            
            Sheets("Risultati").Range(Cells(lRow, "Z"), Cells(lRow + rowMax - 1, "Z")).Value = "Foglio" & i
            lRow = lRow + rowMax - 1
        End With
    Next i
End Sub

La descrizione estesa del foglio 2 (colonna R) è riportata correttamente e non ci sono più interruzioni indesiderate sul foglio 3. Fai sapere.

 

[mark_solPartecipante mark_sol]

Buonasera veccio frac,

grazie di cuore per la disponibilità, proseguo grazie a te con soddisfazione nel lavoro.

Un caro saluto

[vatussPartecipante vatuss]

Buona sera vecchio frac riprendo la discussione per chiederti una cortesia che penso tornerà utile anche a chi giungerà a questo post, è possibile commentare l'esecuzione del codice? Non comprendo:

lRow = 2

e

End If
lCol = lCol + 1
If i = 3 And v = "H" Then lCol = 7
Next

Grazie

[vecchio fracSenior Moderator vecchio frac Karma: 249 pts]

Niente di misterioso... "lRow" e "lCol" sono due variabili Long (la piccola elle davanti ai nomi di variabili è una convenzione, detta notazione ungherese (per esempio si usa anteporre "s" alle variabili stringa, "i" alle variabili Integer) e servono nel codice a identificare la cella del foglio "Risultati" (in termini di riga e colonna) dove inserire il dato. A un certo punto si rende necessario variare la posizione della colonna dove deve essere depositato il dato: se i vale 3 (terza delle tre sequenze di colonne da cui pescare i dati da ricopiare) e v vale "H" (ogni sequenza è suddivisa nelle lettere che la compongono, che sono le singole colonne da cui prendere il dato) allora lCol viene settato a 7, cioè ci si sposta in colonna G.

[Autore]

Articoli