Macro per copiare dati partendo da un elenco

[DALVI]

Salve a tutti,

sono nuovamente a richiedere vs supporto in relazione allo sviluppo di una macro che mi permetta di copiare una selezione di celle da un foglio ad un altro. Cerco di spiegare in breve il risultato che vorrei ottenere:
Foglio2: è il foglio di destinazione nel quale voglio che vengano copiati alcuni dati. In questo foglio sono presenti una lista di nomi, i quali sono sempre nella stessa posizione (F4:F15; F18:F26; F29:F43) .
Foglio1: è la fonte dei dati da copiare e proviene da un report esterno. In questo foglio ho un elenco di voci, tra queste compaiono quelle presenti anche nel foglio2. In corrispondenza di queste voci vi sono dei valori (nelle 2 colonne successive) che dovrò riportare in corrispondenza degli stessi elementi presenti nel foglio2 (nella posizione G4:H15; G18:H26; G29:H43) . Il problema principale è quello di individuare la stessa lista di voci dal foglio1 (in linea con quelle presenti nel foglio2) in quanto nel report che ottengo non sono sempre nello stessa posizione. Indico di seguito la macro di partenza, la quale però non è in grado di riconoscere la posizione della sequenza di voci nel Foglio1.

Codice: Seleziona tutto

Sub Macro1()
Dim Matrix
Dim Righe1, Righe2, Righe3
Dim Colonne


'cancella i dati precedenti
Foglio2.Range("b4:d15,b18:d26,b29:d43").ClearContents


'assegna un range alla matrice
Matrix = Foglio1.Range("c10:g55")


'indica alla matrice le righe interessate
Righe1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
Righe2 = Array(16, 17, 18, 19, 20, 21, 22, 23, 24)
Righe3 = Array(32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46)


'indica alla matrice le colonne interessate
Colonne = Array(Foglio1.Range("f4").Value, Foglio1.Range("f5").Value, Foglio1.Range("f6").Value)
'Colonne = Array(Foglio1.Range("f4"), Foglio1.Range("f5"), Foglio1.Range("f6"))


'copia i range interessati sul foglio2
With Application
    Foglio2.Range("b4:d15") = .Index(Matrix, .Transpose(Righe1), Colonne)
    Foglio2.Range("b18:d26") = .Index(Matrix, .Transpose(Righe2), Colonne)
    Foglio2.Range("b29:d43") = .Index(Matrix, .Transpose(Righe3), Colonne)
End With
End Sub

Volevo mettervi copia del file excel ma non riesco ad allegarla.

[DALVI]

Vi indico di seguito la macro con i riferimenti di cella nel Foglio2 corretti. La parte in corsivo è il princiaple problema che vorrei superare, in riferimento alla selezione dei dati da posizioni diverse da quella indicata.

Codice: Seleziona tutto

Sub Macro1()
Dim Matrix
Dim Righe1, Righe2, Righe3
Dim Colonne


'cancella i dati precedenti
Foglio2.Range("g4:h15,g18:h26,g29:h43").ClearContents


'[i]assegna un range alla matrice
Matrix = Foglio1.Range("c10:g55")


'indica alla matrice le righe interessate
Righe1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
Righe2 = Array(16, 17, 18, 19, 20, 21, 22, 23, 24)
Righe3 = Array(32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46)
[/i]

'indica alla matrice le colonne interessate
Colonne = Array(Foglio1.Range("f4").Value, Foglio1.Range("f5").Value, Foglio1.Range("f6").Value)
'Colonne = Array(Foglio1.Range("f4"), Foglio1.Range("f5"), Foglio1.Range("f6"))


'copia i range interessati sul foglio2
With Application
    Foglio2.Range("g4:h15") = .Index(Matrix, .Transpose(Righe1), Colonne)
    Foglio2.Range("g18:h26") = .Index(Matrix, .Transpose(Righe2), Colonne)
    Foglio2.Range("g29:h43") = .Index(Matrix, .Transpose(Righe3), Colonne)
End With
End Sub


[Anthony47]

E' meglio che alleghi un file dimostrativo, contenente campione dei dati di partenza e dei dati da ottenere.
Per le istruzioni su come allegare un file:
viewtopic.php?f=26&t=103893&p=605487#p605487

Ciao

[DALVI]

Ciao,
grazie per il suggerimento. Ecco il file:
https://wetransfer.com/downloads/de47705a99520dd84df2624a96f9284320170316123122/f1eb37b7a91b9c605dbb5dbbf8f3d46020170316123122/ec5b1f

Grazie

[Anthony47]

C'e' un motivo per cui vuoi usare una macro e non un Cerca.Vert?
Ad esempio, in G4 di Foglio2:

Codice: Seleziona tutto

=CERCA.VERT($F4;Foglio1!$A:$G;RIF.COLONNA(C1);0)


Poi copia verso destra e verto il basso

Ciao

[DALVI]

Ciao,
si, come anticipavo la posizione delle tre sequenze di voci evidenziate nel foglio1 puó variare...Ed io voglio riprodurre la stessa sequenza di dati nel foglio2. Qualora nella colonna A del foglio1 comparisse la stessa voce anche in altre righe sarebbe un problema con il cerca.vert.
in realtà l'esempio indicato, x semplificare, mostra la presenza di quelle sole voci nella colonna A. Ma effettivamente nell'elenco sul quale lavoro può capitare che alcune voci vengano ripetute nel resto della colonna.
grazie

[Anthony47]

Sinceramente non ho capito i termini del problema quindi mi invento qualcosa...

Quindi tu hai un elenco di voci in Foglio2 e lo stesso elenco in posizione non conosciuta di Foglio1, e vorresti riportare in Foglio2 i valori delle colonne adiacenti all'elenco di Foglio1.
Allo scopo ci inventiamo la funzione F1Block, che puo' essere usata in formule Excel con la seguente sintassi:
F1Block(BloccoDaCercare;AreaInCuiCercare;ScartoRestituito)
- BloccoDaCercare e' un intervallo di 1 colonna contenente l'elenco delle voci di nostro interesse
- AreaInCuiCercare e' l'intervallo in cui il primo blocco va ricercato
- ScartoRestituito e' lo scarto (in colonne) rispetto al blocco trovato che verra' restituito dalla funzione; puo' essere sia negativo che positivo; 0 indica il blocco cercato stesso.

La funzione cerchera' in AreaInCuiCercare la posizione in cui esiste esattamente il BloccoDaCercare (le stesse voci nella stessa sequenza) e restituira' i valori che si scostano del numero di colonne indicato in ScartoRestituito; il numero di valori restituiti e' pari al numero di righe di BloccoDaCercare.

Esempi di formule valide:

Codice: Seleziona tutto

=F1Block(F4:F15;Foglio1!A:H;1)


Cerca in Foglio1!A:H la sequenza di valori indicati in F4:F15 e resituisce i valori della prima colonna a destra

Codice: Seleziona tutto

=F1Block($F4:$F15;Foglio1!$A:$H;RIF.COLONNA(A1))


Questa e' equivalente alla precedente, ma e' pronta per essere copiata nelle colonne successive per importare i valori della seconda colonna a destra, terza colonna etc etc

La funzione va usata in forma di matrice, e va inserita su tutta l'area dei risultati. Questo puo' essere ottenuto anche in due passi:
-inserire la formula nella prima cella e controllare che l'esito sia quello voluto.
-selezionare l'intera area dei risultati (compreso la prima cella gia' con formula), premere F2, confermare con Contr-Maiusc-Enter

In caso che nell'area in cui si cerca non si trova il blocco cercato verra' restituito o l'errore #VALORE oppure #N/D

L'uso nel tuo caso dovrebbe essere:
-in Foglio2 - G4 la formula

Codice: Seleziona tutto

=F1Block($F4:$F15;Foglio1!$A:$H;RIF.COLONNA(B1))


Estendere poi la formula all'area G4:G15

In G18 la formula

Codice: Seleziona tutto

=F1Block($F18:$F26;Foglio1!$A:$H;RIF.COLONNA(B1))


Estendere poi la formula all'area G18:G26

In G29 la formula... beh, questa dovresti aver capito la logica e questa la inserirai da solo.

Le probabilita' che questo gioco ti serva e' piu' o meno dello 0.2%; se capiti nel restante 99.8% allora e' evidente che devi spiegare meglio che cosa effettivamente avresti bisogno di fare.

Ah, dimenticavo...
Ovviamente la funzione F1Block dobbiamo crearla col vba; per questo dovrai inserire in un Modulo standard (es Modulo1) il seguente codice:

Codice: Seleziona tutto

Function F1Block(ByRef myBlk As Range, ByRef tgArea As Range, ByVal myOff As Variant) As Variant
Dim C As Range, noMatch As Boolean, myInd As Long
'byAnthony
With tgArea
    Set C = .Find(myBlk.Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlNext)
    If Not C Is Nothing Then
        firstAddress = C.Address
        Do
            For i = 2 To myBlk.Rows.Count
                If C.Cells(i, 1) <> myBlk.Cells(i, 1) Then
                    noMatch = True
                    Exit For
                End If
            Next i
            If Not noMatch Then
            If TypeName(myOff) = "Variant()" Then myInd = myOff(1) Else myInd = myOff
                F1Block = C.Resize(i - 1, 1).Offset(0, myInd).Value
                Exit Function
            End If
            Set C = .FindNext(C)
        Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
F1Block = CVErr(2042)
End With
End Function


Ciao.